packages feed

massiv-test 1.0.0.0 → 1.1.0.0

raw patch · 37 files changed

+1667/−1481 lines, 37 filesdep +quickcheck-classes-basedep −genvalidity-hspecdep ~QuickCheckdep ~massivsetup-changed

Dependencies added: quickcheck-classes-base

Dependencies removed: genvalidity-hspec

Dependency ranges changed: QuickCheck, massiv

Files

CHANGELOG.md view
@@ -1,3 +1,9 @@+# 1.1.0++* Rename `assertException` to `assertDeepException` and `assertExceptionIO` to+  `assertDeepExceptionIO` in order to match functions that were released in+  `QuickCheck-2.15`+ # 1.0.0  * Support for massiv-1.0.0.0
LICENSE view
@@ -1,4 +1,4 @@-Copyright Alexey Kuleshevich (c) 2017-2021+Copyright Alexey Kuleshevich (c) 2017-2022  All rights reserved.
Setup.hs view
@@ -1,3 +1,4 @@ import Distribution.Simple+ main :: IO () main = defaultMain
massiv-test.cabal view
@@ -1,5 +1,5 @@ name:                massiv-test-version:             1.0.0.0+version:             1.1.0.0 synopsis:            Library that contains generators, properties and tests for Massiv Array Library. description:         This library is designed for users of massiv library that need random generators for writing custom property tests and reusing some of the predefined ones. homepage:            https://github.com/lehins/massiv@@ -7,7 +7,7 @@ license-file:        LICENSE author:              Alexey Kuleshevich maintainer:          alexey@kuleshevi.ch-copyright:           2018-2021 Alexey Kuleshevich+copyright:           2018-2022 Alexey Kuleshevich category:            Data, Data Structures, Parallelism build-type:          Simple extra-source-files:  README.md@@ -32,7 +32,8 @@                      , data-default-class                      , deepseq                      , exceptions-                     , QuickCheck+                     , QuickCheck >= 2.14+                     , quickcheck-classes-base                      , hspec                      , massiv >= 1.0 && < 2                      , scheduler@@ -43,9 +44,15 @@   default-language:    Haskell2010   ghc-options:        -Wall                       -Wincomplete-record-updates-                      -Wincomplete-uni-patterns                       -Wredundant-constraints                       -fno-warn-orphans+  if impl(ghc >= 8.2)+    ghc-options:+                      -Wincomplete-uni-patterns+  else+    ghc-options:+                      -Wno-incomplete-patterns+                      -Wno-unused-imports  test-suite tests   type:               exitcode-stdio-1.0@@ -66,6 +73,7 @@                     , Test.Massiv.Array.Ops.TransformSpec                     , Test.Massiv.Array.Manifest.PrimitiveSpec                     , Test.Massiv.Array.Manifest.VectorSpec+                    , Test.Massiv.Array.Manifest.UnboxedSpec                     , Test.Massiv.Array.ManifestSpec                     , Test.Massiv.Array.NumericSpec                     , Test.Massiv.Array.Numeric.IntegralSpec@@ -81,24 +89,30 @@                     , containers                     , data-default                     , deepseq-                    , genvalidity-hspec-                    , massiv >= 0.6+                    , massiv                     , massiv-test                     , mwc-random                     , hspec                     , primitive                     , scheduler                     , QuickCheck+                    , quickcheck-classes-base                     , vector    default-language:   Haskell2010   ghc-options:       -Wall                      -Wincomplete-record-updates-                     -Wincomplete-uni-patterns                      -Wredundant-constraints                      -fno-warn-orphans                      -threaded                      -with-rtsopts=-N2+  if impl(ghc >= 8.2)+    ghc-options:+                      -Wincomplete-uni-patterns+  else+    ghc-options:+                      -Wno-incomplete-patterns+                      -Wno-unused-imports   test-suite tests-O0@@ -120,6 +134,7 @@                     , Test.Massiv.Array.Ops.TransformSpec                     , Test.Massiv.Array.Manifest.PrimitiveSpec                     , Test.Massiv.Array.Manifest.VectorSpec+                    , Test.Massiv.Array.Manifest.UnboxedSpec                     , Test.Massiv.Array.ManifestSpec                     , Test.Massiv.Array.NumericSpec                     , Test.Massiv.Array.Numeric.IntegralSpec@@ -135,26 +150,33 @@                     , containers                     , data-default                     , deepseq-                    , genvalidity-hspec-                    , massiv >= 0.6+                    , massiv                     , massiv-test                     , mwc-random                     , hspec                     , primitive                     , scheduler                     , QuickCheck+                    , quickcheck-classes-base                     , vector    default-language:   Haskell2010   ghc-options:       -Wall                      -Wincomplete-record-updates-                     -Wincomplete-uni-patterns                      -Wredundant-constraints                      -fno-warn-orphans                      -threaded                      -with-rtsopts=-N2                      -O0+  if impl(ghc >= 8.2)+    ghc-options:+                      -Wincomplete-uni-patterns+  else+    ghc-options:+                      -Wno-incomplete-patterns+                      -Wno-unused-imports  source-repository head   type:     git   location: https://github.com/lehins/massiv+  subdir:   massiv-test
src/Test/Massiv/Array/Delayed.hs view
@@ -5,34 +5,37 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}-module Test.Massiv.Array.Delayed-  ( -- * Spec for safe Mutable instance-    delayedStreamSpec-    -- * Useful properties for testing toList conversion-  , prop_toStream-  , prop_toStreamIsList-  , prop_toStreamFoldable-  , prop_sfilter-  , prop_smapMaybe-  , prop_takeDrop-  , prop_sunfoldr-  -- * Random reimplementations-  , stackSlices'-  ) where+{-# LANGUAGE TypeOperators #-} +module Test.Massiv.Array.Delayed (+  -- * Spec for safe Mutable instance+  delayedStreamSpec, -import Data.Maybe as M+  -- * Useful properties for testing toList conversion+  prop_toStream,+  prop_toStreamIsList,+  prop_toStreamFoldable,+  prop_sfilter,+  prop_smapMaybe,+  prop_takeDrop,+  prop_sunfoldr,++  -- * Random reimplementations+  stackSlices',+) where+ import Data.Foldable as F+import Data.List as L import Data.Massiv.Array as A import qualified Data.Massiv.Vector.Stream as S+import Data.Maybe as M+import qualified GHC.Exts as Exts import Test.Massiv.Core.Common () import Test.Massiv.Utils as T-import qualified GHC.Exts as Exts-import Data.List as L --- | Alternative implementation of `stackSlicesM` with `concat'`. Useful for testing and benchmarks-stackSlices' ::-     (Functor f, Foldable f, Source r e, Index ix, Load r (Lower ix) e)+-- | Alternative implementation of `stackSlicesM` with 'concat''. Useful for testing and benchmarks+stackSlices'+  :: (Functor f, Foldable f, Source r e, Index ix, Load r (Lower ix) e)   => Dim   -> f (Array r (Lower ix) e)   -> Array DL ix e@@ -40,57 +43,59 @@   let fixupSize arr = resize' (Sz (insertDim' (unSz (size arr)) dim 1)) arr    in concat' dim $ fmap fixupSize arrsF -compareAsListAndLoaded ::-     (Eq e, Show e, Foldable (Array r' Ix1), Load r' Ix1 e) => Array r' Ix1 e -> [e] -> Property+compareAsListAndLoaded+  :: (Eq e, Show e, Foldable (Array r' Ix1), Load r' Ix1 e) => Array r' Ix1 e -> [e] -> Property compareAsListAndLoaded str ls =   F.toList str === ls .&&. computeAs B str === A.fromList Seq ls  -- | Compare `toStream` and `A.toList`-prop_toStream ::-     forall r ix e. (Source r e, Stream r ix e, Show e, Eq e)+prop_toStream+  :: forall r ix e+   . (Source r e, Stream r ix e, Show e, Eq e)   => Array r ix e   -> Property prop_toStream arr =   A.toList arr === S.toList (toStream arr)  -- | Compare `toStream` and `Exts.toList`-prop_toStreamIsList ::-     forall r e.-     (Exts.Item (Array r Ix1 e) ~ e, Exts.IsList (Array r Ix1 e), Stream r Ix1 e, Show e, Eq e)+prop_toStreamIsList+  :: forall r e+   . (Exts.Item (Array r Ix1 e) ~ e, Exts.IsList (Array r Ix1 e), Stream r Ix1 e, Show e, Eq e)   => Array r Ix1 e   -> Property prop_toStreamIsList arr =   Exts.toList arr === S.toList (toStream arr)  -- | Compare `toStream` and `F.toList`-prop_toStreamFoldable ::-     forall r ix e.-     (Foldable (Array r ix), Stream r ix e, Show e, Eq e)+prop_toStreamFoldable+  :: forall r ix e+   . (Foldable (Array r ix), Stream r ix e, Show e, Eq e)   => Array r ix e   -> Property prop_toStreamFoldable arr =   F.toList arr === S.toList (toStream arr) --prop_sfilter ::-     forall r ix e. (Eq e, Show e, Stream r ix e, Foldable (Array r ix))+prop_sfilter+  :: forall r ix e+   . (Eq e, Show e, Stream r ix e, Foldable (Array r ix))   => Array r ix e   -> Fun e Bool   -> Property prop_sfilter arr f =   compareAsListAndLoaded (A.sfilter (apply f) arr) (L.filter (apply f) (F.toList arr)) -prop_smapMaybe ::-     forall r ix e a. (Eq a, Show a, Stream r ix e, Foldable (Array r ix))+prop_smapMaybe+  :: forall r ix e a+   . (Eq a, Show a, Stream r ix e, Foldable (Array r ix))   => Array r ix e   -> Fun e (Maybe a)   -> Property prop_smapMaybe arr f =   compareAsListAndLoaded (A.smapMaybe (apply f) arr) (M.mapMaybe (apply f) (F.toList arr)) --prop_sunfoldr ::-     forall e s. (Eq e, Show e)+prop_sunfoldr+  :: forall e s+   . (Eq e, Show e)   => Fun s (Maybe (e, s))   -> s   -> NonNegative Int@@ -100,8 +105,9 @@     (A.stake (Sz n) (A.sunfoldr (apply f) s0))     (L.take n (L.unfoldr (apply f) s0)) -prop_sunfoldrN ::-     forall e s. (Eq e, Show e)+prop_sunfoldrN+  :: forall e s+   . (Eq e, Show e)   => Fun s (Maybe (e, s))   -> s   -> Int@@ -109,10 +115,9 @@ prop_sunfoldrN f s0 n =   compareAsListAndLoaded (A.sunfoldrN (Sz n) (apply f) s0) (L.take n (L.unfoldr (apply f) s0)) --prop_stakesDrop ::-     forall r e.-     ( Eq e+prop_stakesDrop+  :: forall r e+   . ( Eq e      , Show e      , Stream r Ix1 e      , Foldable (Array r Ix1)@@ -127,9 +132,9 @@     , stoList (A.sdrop (Sz d) (A.stake (Sz t) arr)) === L.drop d (L.take t (F.toList arr))     ] -prop_takeDrop ::-     forall r e.-     ( Eq e+prop_takeDrop+  :: forall r e+   . ( Eq e      , Show e      , Source r e      , Foldable (Array r Ix1)@@ -147,7 +152,8 @@ delayedStreamSpec :: Spec delayedStreamSpec = do   describe "D Spec" $-    it "takeDrop" $ property (prop_takeDrop @D @Int)+    it "takeDrop" $+      property (prop_takeDrop @D @Int)   describe "DS Spec" $ do     it "sfilter" $ property (prop_sfilter @DS @Ix1 @Int)     it "smapMaybe" $ property (prop_smapMaybe @DS @Ix1 @Int @Word)
src/Test/Massiv/Array/Load.hs view
@@ -5,19 +5,16 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}-module Test.Massiv.Array.Load-  ( -- * Spec for loadable representations-    loadSpec-  ) where +module Test.Massiv.Array.Load (loadSpec) where  import Data.Massiv.Array as A import Test.Massiv.Core.Common () import Test.Massiv.Utils as T -prop_replicate ::-     forall r ix e.-     ( Eq e+prop_replicate+  :: forall r ix e+   . ( Eq e      , Show e      , Load r ix e      , Ragged L ix e@@ -27,12 +24,12 @@   -> e   -> Property prop_replicate comp sz e = propIO $ do-  computeAs B (A.replicate @r comp sz e) `shouldBe`-    computeAs B (makeArrayLinear @r comp sz (const e))+  computeAs B (A.replicate @r comp sz e)+    `shouldBe` computeAs B (makeArrayLinear @r comp sz (const e)) -prop_makeArray ::-     forall r ix e.-     ( Eq e+prop_makeArray+  :: forall r ix e+   . ( Eq e      , Show e      , Load r ix e      , Ragged L ix e@@ -46,10 +43,9 @@   computeAs B (makeArray @r comp sz (applyFun f)) `shouldBe` barr   computeAs B (makeArrayLinear @r comp sz (applyFun f . fromLinearIndex sz)) `shouldBe` barr --loadSpec ::-     forall r ix e.-     ( Eq e+loadSpec+  :: forall r ix e+   . ( Eq e      , Show e      , Typeable e      , Arbitrary e@@ -61,6 +57,6 @@      )   => Spec loadSpec = do-  describe (("LoadSpec "  ++) . showsArrayType @r @ix @e $ "") $ do+  describe (("LoadSpec " ++) . showsArrayType @r @ix @e $ "") $ do     prop "replicate" $ prop_replicate @r @ix @e     prop "makeArray" $ prop_makeArray @r @ix @e
src/Test/Massiv/Array/Mutable.hs view
@@ -4,19 +4,21 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}-module Test.Massiv.Array.Mutable-  ( -- * Spec for safe Mutable instance-    mutableSpec-  , prop_GenerateArray-  , prop_iMapiMapM-  , prop_Shrink-  , prop_GrowShrink-  , prop_unfoldrList-  , prop_unfoldrReverseUnfoldl-  , prop_toStreamArrayManifest++module Test.Massiv.Array.Mutable (+  -- * Spec for safe Mutable instance+  mutableSpec,+  prop_GenerateArray,+  prop_iMapiMapM,+  prop_Shrink,+  prop_GrowShrink,+  prop_unfoldrList,+  prop_unfoldrReverseUnfoldl,+  prop_toStreamArrayManifest,+   -- * Atomic ops spec-  , atomicIntSpec-  ) where+  atomicIntSpec,+) where  import Control.Scheduler import Data.Bits@@ -30,24 +32,24 @@ import Test.Massiv.Utils as T import UnliftIO.Async - -- prop_MapMapM :: forall r ix(Show (Array r ix Word), Eq (Array r ix Word), Manifest r ix) => --                 Fun Word Word -> ArrTiny D ix Word -> Property -- prop_MapMapM r _ f (ArrTiny arr) = --   computeAs r (A.map (apply f) arr) === runIdentity (A.mapMR r (return . apply f) arr) -prop_iMapiMapM ::-     forall r ix e. (Show (Array r ix e), Eq (Array r ix e), Manifest r e, Index ix)+prop_iMapiMapM+  :: forall r ix e+   . (Show (Array r ix e), Eq (Array r ix e), Manifest r e, Index ix)   => Fun (ix, e) e   -> Array D ix e   -> Property prop_iMapiMapM f arr =-  (compute (A.imap (curry (apply f)) arr) :: Array r ix e) ===-  runIdentity (A.imapM (\ix e -> pure $ apply f (ix, e)) arr)+  (compute (A.imap (curry (apply f)) arr) :: Array r ix e)+    === runIdentity (A.imapM (\ix e -> pure $ apply f (ix, e)) arr) -prop_GenerateArray ::-     forall r ix e.-     ( Show (Array r ix e)+prop_GenerateArray+  :: forall r ix e+   . ( Show (Array r ix e)      , Eq (Array r ix e)      , Manifest r e      , Load r ix e@@ -67,20 +69,20 @@     arrIO <- generateArray (getComp arr) (size arr) (evaluateM arr)     arrIO `shouldBe` arr -prop_Shrink ::-     forall r ix e.-     (Show (Array r ix e), Manifest r e, Load r ix e, Arbitrary ix, Arbitrary e, Eq e)+prop_Shrink+  :: forall r ix e+   . (Show (Array r ix e), Manifest r e, Load r ix e, Arbitrary ix, Arbitrary e, Eq e)   => Property-prop_Shrink  =-  property $ \ (ArrIx arr ix) -> runST $ do+prop_Shrink =+  property $ \(ArrIx arr ix) -> runST $ do     marr :: MArray s r ix e <- thawS arr     sarr <- unsafeFreeze (getComp arr) =<< unsafeLinearShrink marr (Sz ix)     pure (A.foldlS (.&&.) (property True) $ A.zipWith (==) (flatten arr) (flatten sarr))  -- TODO: Improve runtime speed!-prop_GrowShrink ::-     forall r ix e.-     ( Eq (Array r ix e)+prop_GrowShrink+  :: forall r ix e+   . ( Eq (Array r ix e)      , Show (Array r ix e)      , Load r ix e      , Manifest r e@@ -90,7 +92,7 @@      )   => Property prop_GrowShrink =-  property $ \ (ArrNE arr) (NonNegative delta) e -> runST $ do+  property $ \(ArrNE arr) (NonNegative delta) e -> runST $ do     let sz = size (arr :: Array r ix e)         k = getDim' (unSz sz) (dimensions sz)         -- increase the outer most dimension, just so the structure doesn't change@@ -103,11 +105,9 @@     sarr <- freezeS =<< unsafeLinearShrink grownMarr sz     pure (garr === arr .&&. sarr === arr) ---prop_unfoldrList ::-     forall r ix e.-     ( Show (Array r Ix1 e)+prop_unfoldrList+  :: forall r ix e+   . ( Show (Array r Ix1 e)      , Eq (Array r Ix1 e)      , Index ix      , Arbitrary ix@@ -122,10 +122,9 @@         ys = A.fromList comp (L.take (totalElem sz) (L.unfoldr (Just . apply f) i))      in flatten xs === ys --prop_unfoldrReverseUnfoldl ::-     forall r ix e.-     ( Show (Array r ix e)+prop_unfoldrReverseUnfoldl+  :: forall r ix e+   . ( Show (Array r ix e)      , Eq (Array r ix e)      , Index ix      , Arbitrary ix@@ -135,23 +134,26 @@      )   => Property prop_unfoldrReverseUnfoldl =-  property $ \ sz f (i :: Word) ->+  property $ \sz f (i :: Word) ->     let swapTuple (x, y) = (y, x)         rev a =           compute @r (backpermute' sz (liftIndex pred . liftIndex2 (-) (unSz sz)) a)-     in do a1 :: Array r ix e <- unfoldrPrimM_ @r sz (pure . apply f) i-           a2 <- unfoldlPrimM_ @r sz (pure . swapTuple . apply f) i-           rev a1 `shouldBe` a2+     in do+          a1 :: Array r ix e <- unfoldrPrimM_ @r sz (pure . apply f) i+          a2 <- unfoldlPrimM_ @r sz (pure . swapTuple . apply f) i+          rev a1 `shouldBe` a2 -prop_toStreamArrayManifest ::-     forall r ix e. (Manifest r e, Index ix, Show (Array r ix e), Eq (Array r ix e))+prop_toStreamArrayManifest+  :: forall r ix e+   . (Manifest r e, Index ix, Show (Array r ix e), Eq (Array r ix e))   => Array r ix e   -> Property prop_toStreamArrayManifest arr =   arr === S.unstreamExact (size arr) (S.stepsStream (toSteps (toStreamArray arr))) -prop_WithMArray ::-     forall r ix e. (HasCallStack, Index ix, Manifest r e, Eq (Array r ix e), Show (Array r ix e))+prop_WithMArray+  :: forall r ix e+   . (HasCallStack, Index ix, Manifest r e, Eq (Array r ix e), Show (Array r ix e))   => Array r ix e   -> Fun e e   -> Fun e e@@ -177,9 +179,9 @@     let arr6 = withLoadMArrayST_ (A.map (applyFun f) arr) $ \marr -> forPrimM marr g'     arr6 `shouldBe` arr' -mutableSpec ::-     forall r ix e.-     ( Show (Array D ix e)+mutableSpec+  :: forall r ix e+   . ( Show (Array D ix e)      , Show (Array r ix e)      , Show (Vector r e)      , Eq (Vector r e)@@ -189,6 +191,7 @@      , Show e      , Eq e      , Manifest r e+     , Arbitrary (Array r ix e)      , CoArbitrary ix      , Arbitrary e      , CoArbitrary e@@ -208,15 +211,17 @@     it "unfoldrList" $ prop_unfoldrList @r @ix @e     it "unfoldrReverseUnfoldl" $ prop_unfoldrReverseUnfoldl @r @ix @e   describe "Stream" $-    prop "toStreamArrayMutable" $ prop_toStreamArrayManifest @r @ix @e+    prop "toStreamArrayMutable" $+      prop_toStreamArrayManifest @r @ix @e  -- | Try to write many elements into the same array cell concurrently, while keeping the -- previous element for each write. With atomic writes, not a single element should be lost.-prop_atomicModifyIntArrayMany ::-     forall ix. (Show (Array P ix Int), Arbitrary ix, Index ix)+prop_atomicModifyIntArrayMany+  :: forall ix+   . (Show (Array P ix Int), Arbitrary ix, Index ix)   => Property prop_atomicModifyIntArrayMany =-  property $ \(ArrIx arr ix) (ys :: Array B Ix1 Int)  -> do+  property $ \(ArrIx arr ix) (ys :: Array B Ix1 Int) -> do     marr <- thaw arr     atomicModifyIntArray marr (liftIndex (subtract 1 . negate) ix) succ `shouldReturn` Nothing     mys <- mapConcurrently (atomicModifyIntArray marr ix . const) ys@@ -225,8 +230,9 @@     y <- indexM arr ix     L.sort (y : toList ys) `shouldBe` L.sort xs -prop_atomicReadIntArray ::-     forall ix. (Show (Array P ix Int), Arbitrary ix, Index ix)+prop_atomicReadIntArray+  :: forall ix+   . (Show (Array P ix Int), Arbitrary ix, Index ix)   => Property prop_atomicReadIntArray =   property $ \arr (ix :: ix) -> do@@ -234,22 +240,29 @@     mx <- A.read marr ix     atomicReadIntArray marr ix `shouldReturn` mx -prop_atomicWriteIntArray ::-     forall ix. (Show (Array P ix Int), Arbitrary ix, Index ix)+prop_atomicWriteIntArray+  :: forall ix+   . (Show (Array P ix Int), Arbitrary ix, Index ix)   => Property prop_atomicWriteIntArray =   property $ \arr (ix :: ix) (e :: Int) -> do     marr <- unsafeThaw arr     mx <- A.read marr ix     atomicWriteIntArray marr ix e `shouldReturn` isJust mx-    T.forM_ mx $ \ _ ->+    T.forM_ mx $ \_ ->       A.read marr ix `shouldReturn` Just e -prop_atomicOpIntArray ::-     forall ix. (Show (Array P ix Int), Arbitrary ix, Index ix)+prop_atomicOpIntArray+  :: forall ix+   . (Show (Array P ix Int), Arbitrary ix, Index ix)   => (Int -> Int -> Int)-  -> (forall m. PrimMonad m =>-                  MArray (PrimState m) P ix Int -> ix -> Int -> m (Maybe Int))+  -> ( forall m+        . PrimMonad m+       => MArray (PrimState m) P ix Int+       -> ix+       -> Int+       -> m (Maybe Int)+     )   -> Property prop_atomicOpIntArray f atomicAction =   property $ \arr (ix :: ix) (e :: Int) -> do@@ -258,8 +271,9 @@     atomicAction marr ix e `shouldReturn` mx     T.forM_ mx $ \x -> A.readM marr ix `shouldReturn` f x e -prop_casIntArray ::-     forall ix. (Show (Array P ix Int), Arbitrary ix, Index ix)+prop_casIntArray+  :: forall ix+   . (Show (Array P ix Int), Arbitrary ix, Index ix)   => Property prop_casIntArray =   property $ \arr (ix :: ix) (e :: Int) -> do@@ -271,9 +285,9 @@         casIntArray marr ix x e `shouldReturn` mx         A.readM marr ix `shouldReturn` e --atomicIntSpec ::-     forall ix. (Show (Array P ix Int), Arbitrary ix, Index ix)+atomicIntSpec+  :: forall ix+   . (Show (Array P ix Int), Arbitrary ix, Index ix)   => Spec atomicIntSpec =   describe "Atomic Int Operations" $ do
src/Test/Massiv/Array/Numeric.hs view
@@ -5,55 +5,57 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}-module Test.Massiv.Array.Numeric-  ( -- * Spec for safe Manifest instance-    prop_MatrixMatrixMultiply-  , mutableNumericSpec-  , mutableNumericFloatSpec-  ) where +module Test.Massiv.Array.Numeric (+  -- * Spec for safe Manifest instance+  prop_MatrixMatrixMultiply,+  mutableNumericSpec,+  mutableNumericFloatSpec,+) where+ import Data.Massiv.Array as A-import Test.Massiv.Utils as T import Test.Massiv.Core.Common ()-+import Test.Massiv.Utils as T -naiveMatrixMatrixMultiply ::-     (Num e, Source r1 e, Source r2 e)+naiveMatrixMatrixMultiply+  :: (Num e, Source r1 e, Source r2 e)   => Array r1 Ix2 e   -> Array r2 Ix2 e   -> Array D Ix2 e naiveMatrixMatrixMultiply arr1 arr2   | n1 /= m2 =-    error $-    "(|*|): Inner array dimensions must agree, but received: " ++-    show (size arr1) ++ " and " ++ show (size arr2)+      error $+        "(|*|): Inner array dimensions must agree, but received: "+          ++ show (size arr1)+          ++ " and "+          ++ show (size arr2)   | isEmpty arr1 || isEmpty arr2 = empty   | otherwise =-    makeArrayR D Seq (Sz (m1 :. n2)) $ \(i :. j) ->-      A.foldlS (+) 0 (A.zipWith (*) (arr1 !> i) (arr2 <! j))+      makeArrayR D Seq (Sz (m1 :. n2)) $ \(i :. j) ->+        A.foldlS (+) 0 (A.zipWith (*) (arr1 !> i) (arr2 <! j))   where     Sz2 m1 n1 = size arr1     Sz2 m2 n2 = size arr2 {-# INLINE naiveMatrixMatrixMultiply #-} --prop_MatrixMatrixMultiply ::-     forall r e. (Numeric r e, Manifest r e, Eq (Matrix r e), Show (Matrix r e))+prop_MatrixMatrixMultiply+  :: forall r e+   . (Numeric r e, Manifest r e, Eq (Matrix r e), Show (Matrix r e))   => Fun e e   -> Matrix r e   -> Property prop_MatrixMatrixMultiply f arr = expectProp $ do   let arr' = A.transpose (A.map (applyFun f) arr)   arr !><! compute arr' `shouldBe` compute (naiveMatrixMatrixMultiply (delay arr) arr')-  arr !><! compute (transpose arr) `shouldBe`-    compute (naiveMatrixMatrixMultiply (delay arr) (transpose arr))+  arr !><! compute (transpose arr)+    `shouldBe` compute (naiveMatrixMatrixMultiply (delay arr) (transpose arr))   let Sz2 m n = size arr   when (m /= n) $     arr .><. arr `shouldThrow` (== SizeMismatchException (size arr) (Sz2 m n)) -prop_MatrixVectorMultiply ::-     forall r e.-     ( Numeric r e+prop_MatrixVectorMultiply+  :: forall r e+   . ( Numeric r e      , Manifest r e      , Load r Ix1 e      , Eq e@@ -67,12 +69,12 @@     let Sz2 _ n = size arr         v = makeArray Seq (Sz n) (applyFun f)     arr !>< v `shouldBe` flatten (naiveMatrixMatrixMultiply (delay arr) (resize' (Sz2 n 1) v))-    arr .>< makeArray Seq (Sz (n + 1)) (applyFun f) `shouldThrow`-      (== SizeMismatchException (size arr) (Sz2 (n + 1) 1))+    arr .>< makeArray Seq (Sz (n + 1)) (applyFun f)+      `shouldThrow` (== SizeMismatchException (size arr) (Sz2 (n + 1) 1)) -prop_VectorMatrixMultiply ::-     forall r e.-     ( Numeric r e+prop_VectorMatrixMultiply+  :: forall r e+   . ( Numeric r e      , Load r Ix1 e      , Manifest r e      , Show (Vector r e)@@ -85,14 +87,15 @@   expectProp $ do     let Sz2 m _ = size arr         v = makeArray Seq (Sz m) (applyFun f)-    v ><! arr `shouldBe`-      compute (flatten (naiveMatrixMatrixMultiply (resize' (Sz2 1 m) v) (delay arr)))+    v ><! arr+      `shouldBe` compute (flatten (naiveMatrixMatrixMultiply (resize' (Sz2 1 m) v) (delay arr)))     multiplyVectorByMatrix v arr `shouldReturn` compute (v ><! arr)-    makeArray Seq (Sz (m + 1)) (applyFun f) ><. arr `shouldThrow`-      (== SizeMismatchException (Sz2 1 (m + 1)) (size arr))+    makeArray Seq (Sz (m + 1)) (applyFun f) ><. arr+      `shouldThrow` (== SizeMismatchException (Sz2 1 (m + 1)) (size arr)) -prop_DotProduct ::-     forall r e. (Numeric r e, Manifest r e, Eq e, Show e, Load r Ix1 e)+prop_DotProduct+  :: forall r e+   . (Numeric r e, Manifest r e, Eq e, Show e, Load r Ix1 e)   => Fun e e   -> Vector r e   -> Property@@ -100,21 +103,20 @@   expectProp $ do     let v' = A.map (applyFun f) v     v !.! compute v' `shouldBe` A.sum (A.zipWith (*) v v')-    dotM v (makeArray Seq (size v + 1) (const 0)) `shouldThrow`-      (== SizeMismatchException (size v) (size v + 1))+    dotM v (makeArray Seq (size v + 1) (const 0))+      `shouldThrow` (== SizeMismatchException (size v) (size v + 1)) -prop_Norm ::-     forall r e. (NumericFloat r e, Manifest r e, RealFloat e, Show e)+prop_Norm+  :: forall r e+   . (NumericFloat r e, Manifest r e, RealFloat e, Show e)   => e   -> Vector r e   -> Property prop_Norm eps v = epsilonEq eps (sqrt (v !.! v)) (normL2 v) ---prop_Plus ::-     forall r e.-     (Numeric r e, Manifest r e, Show (Matrix r e), Eq (Matrix r e))+prop_Plus+  :: forall r e+   . (Numeric r e, Manifest r e, Show (Matrix r e), Eq (Matrix r e))   => Fun e e   -> Matrix r e   -> e@@ -128,9 +130,9 @@   when (m /= n && m * n /= 0) $     arr .+. compute (transpose arr) `shouldThrow` (== SizeMismatchException (size arr) (Sz2 n m)) -prop_Minus ::-     forall r e.-     (Numeric r e, Manifest r e, Show (Array r Ix2 e), Eq (Array r Ix2 e))+prop_Minus+  :: forall r e+   . (Numeric r e, Manifest r e, Show (Array r Ix2 e), Eq (Array r Ix2 e))   => Fun e e   -> Matrix r e   -> e@@ -144,9 +146,9 @@   when (m /= n && m * n /= 0) $     arr .-. compute (transpose arr) `shouldThrow` (== SizeMismatchException (size arr) (Sz2 n m)) -prop_Times ::-     forall r e.-     (Numeric r e, Manifest r e, Show (Matrix r e), Eq (Matrix r e))+prop_Times+  :: forall r e+   . (Numeric r e, Manifest r e, Show (Matrix r e), Eq (Matrix r e))   => Fun e e   -> Matrix r e   -> e@@ -160,16 +162,17 @@   when (m /= n && m * n /= 0) $     arr .*. compute (transpose arr) `shouldThrow` (== SizeMismatchException (size arr) (Sz2 n m)) -prop_Divide ::-     forall r e.-     ( NumericFloat r e+prop_Divide+  :: forall r e+   . ( NumericFloat r e      , Manifest r e      , Show e      , RealFloat e      , Show (Matrix r e)      , Eq (Matrix r e)      )-  => e -- ^ Epsilon+  => e+  -- ^ Epsilon   -> Fun e e   -> Matrix r e   -> e@@ -184,8 +187,9 @@   when (m /= n && m * n /= 0) $     arr ./. compute (transpose arr) `shouldThrow` (== SizeMismatchException (size arr) (Sz2 n m)) -prop_Floating ::-     forall r e. (RealFloat e, Source r e, NumericFloat r e, Show e)+prop_Floating+  :: forall r e+   . (RealFloat e, Source r e, NumericFloat r e, Show e)   => e   -> Matrix r e   -> Property@@ -209,8 +213,9 @@   epsilonFoldableExpect eps (delay (acoshA arr)) (A.map acosh arr)   epsilonFoldableExpect eps (delay (atanhA arr)) (A.map atanh arr) -prop_Floating2 ::-     forall r e. (RealFloat e, Manifest r e, NumericFloat r e, Show e)+prop_Floating2+  :: forall r e+   . (RealFloat e, Manifest r e, NumericFloat r e, Show e)   => e   -> Matrix r e   -> Fun e e@@ -222,10 +227,9 @@   res <- atan2A arr1 arr2   epsilonFoldableExpect eps (delay res) (A.zipWith atan2 arr1 arr2) --mutableNumericSpec ::-     forall r e.-     ( Numeric r e+mutableNumericSpec+  :: forall r e+   . ( Numeric r e      , Manifest r e      , Load r Ix1 e      , Load r Ix2 e@@ -248,24 +252,32 @@     prop "Minus" $ prop_Minus @r @e     prop "Times" $ prop_Times @r @e     prop "DotProduct" $ prop_DotProduct @r @e-    prop "Power" $ \(arr :: Array r Ix2 e) (NonNegative p) -> expectProp $-      arr .^ p `shouldBe` compute (A.map (^ p) arr)+    prop "Power" $ \(arr :: Array r Ix2 e) (NonNegative p) ->+      expectProp $+        arr .^ p `shouldBe` compute (A.map (^ p) arr)     prop "MatrixMatrixMultiply" $ prop_MatrixMatrixMultiply @r @e     prop "MatrixVectorMultiply" $ prop_MatrixVectorMultiply @r @e     prop "VectorMatrixMultiply" $ prop_VectorMatrixMultiply @r @e-    prop "Identity" $ \ n -> expectProp $ do-      computeIO (identityMatrix (Sz n)) `shouldReturn`-        makeArray @r Seq (Sz2 n n) (\ (i :. j) -> if i == j then 1 else 0 :: e)-    prop "LowerTriangular" $ \ comp n f -> expectProp $ do-      computeIO (lowerTriangular comp (Sz n) (applyFun f . fromIx2)) `shouldReturn`-        makeArray @r Seq (Sz2 n n) (\ (i :. j) -> if i >= j then applyFun f (i, j) else 0 :: e)-    prop "UpperTriangular" $ \ comp n f -> expectProp $ do-      computeIO (upperTriangular comp (Sz n) (applyFun f . fromIx2)) `shouldReturn`-        makeArray @r Seq (Sz2 n n) (\ (i :. j) -> if i <= j then applyFun f (i, j) else 0 :: e)+    prop "Identity" $ \n -> expectProp $ do+      computeIO (identityMatrix (Sz n))+        `shouldReturn` makeArray @r Seq (Sz2 n n) (\(i :. j) -> if i == j then 1 else 0 :: e)+    prop "LowerTriangular" $ \comp n f -> expectProp $ do+      computeIO (lowerTriangular comp (Sz n) (funIx2 f))+        `shouldReturn` makeArray @r Seq (Sz2 n n) (\(i :. j) -> if i >= j then applyFun f (i, j) else 0 :: e)+    prop "UpperTriangular" $ \comp n f -> expectProp $ do+      computeIO (upperTriangular comp (Sz n) (funIx2 f))+        `shouldReturn` makeArray @r Seq (Sz2 n n) (\(i :. j) -> if i <= j then applyFun f (i, j) else 0 :: e)+    prop "LowerTriangular==UpperTriangular'" $ \comp n f -> expectProp $ do+      computeIO (lowerTriangular comp (Sz n) (funIx2 f))+        `shouldReturn` compute @r @Ix2 @e+          (transpose (compute @r (upperTriangular comp (Sz n) (funIx2 f . swapIx2))))+  where+    funIx2 f = applyFun f . fromIx2+    swapIx2 (x :. y) = y :. x -mutableNumericFloatSpec ::-     forall r.-     ( NumericFloat r Float+mutableNumericFloatSpec+  :: forall r+   . ( NumericFloat r Float      , Manifest r Float      , Arbitrary (Vector r Float)      , Arbitrary (Matrix r Float)@@ -298,7 +310,8 @@       prop "Norm" $ prop_Norm @r ed       prop "Power" $ prop_Power @r ed -prop_Power ::-     (Numeric r e, Source r e, RealFloat e, Show e) => e -> Matrix r e -> Int -> Property-prop_Power eps arr p = expectProp $-  epsilonFoldableExpect eps (delay (arr .^^ p)) (A.map (^^ p) arr)+prop_Power+  :: (Numeric r e, Source r e, RealFloat e, Show e) => e -> Matrix r e -> Int -> Property+prop_Power eps arr p =+  expectProp $+    epsilonFoldableExpect eps (delay (arr .^^ p)) (A.map (^^ p) arr)
src/Test/Massiv/Core.hs view
@@ -1,11 +1,11 @@-module Test.Massiv.Core-  ( module Index-  , module Commmon-  , module Utils-  , module Test.Hspec.QuickCheck-  ) where+module Test.Massiv.Core (+  module Index,+  module Commmon,+  module Utils,+  module Test.Hspec.QuickCheck,+) where -import Test.Massiv.Core.Index as Index (DimIx(..), SzIx(..), SzNE(..))+import Test.Hspec.QuickCheck import Test.Massiv.Core.Common as Commmon+import Test.Massiv.Core.Index as Index (DimIx (..), SzIx (..), SzNE (..)) import Test.Massiv.Utils as Utils-import Test.Hspec.QuickCheck
src/Test/Massiv/Core/Common.hs view
@@ -1,24 +1,25 @@ {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-}-module Test.Massiv.Core.Common-  ( ArrNE(..)-  , ArrTiny(..)-  , ArrTinyNE(..)-  , ArrIx(..)-  , ArrDW(..)-  , module X-  ) where +module Test.Massiv.Core.Common (+  ArrNE (..),+  ArrTiny (..),+  ArrTinyNE (..),+  ArrIx (..),+  ArrDW (..),+  module X,+) where+ import Data.Massiv.Array import Test.Massiv.Core.Index as X import Test.Massiv.Utils --- -- | Arbitrary non-empty array. Computation strategy can be either `Seq` or `Par`. -- -- @since 0.1.0@@ -50,77 +51,117 @@ deriving instance (Show (Array r ix e)) => Show (ArrTinyNE r ix e) deriving instance (Show (Array r ix e), Show ix) => Show (ArrIx r ix e) -- instance Arbitrary Comp where   arbitrary =     frequency       [ (20, pure Seq)       , (10, pure Par)+      , (10, pure Par')       , (15, ParOn <$> arbitrary)       , (15, ParN . getSmall <$> arbitrary)       ] - arbitraryArray :: (Load r ix e, Arbitrary e) => Gen (Sz ix) -> Gen (Array r ix e)-arbitraryArray szGen = makeArrayLinear <$> arbitrary <*> szGen <*> arbitrary+arbitraryArray szGen =+  oneof+    [ do+        comp <- arbitrary+        sz <- szGen+        f <- arbitrary+        pure $ makeArray comp sz (applyFun f . toLinearIndex sz)+    , makeArrayLinear <$> arbitrary <*> szGen <*> arbitrary+    ]  -- | Arbitrary array-instance (Arbitrary ix, Load r ix e, Arbitrary e) =>-         Arbitrary (Array r ix e) where-  arbitrary = makeArrayLinear <$> arbitrary <*> arbitrary <*> arbitrary+instance (Arbitrary ix, Index ix, Arbitrary e) => Arbitrary (Array D ix e) where+  arbitrary = arbitraryArray arbitrary +instance (Arbitrary ix, Index ix, Arbitrary e) => Arbitrary (Array DL ix e) where+  arbitrary = arbitraryArray arbitrary+instance (Arbitrary ix, Index ix, Arbitrary e) => Arbitrary (Array DI ix e) where+  arbitrary = arbitraryArray arbitrary+instance (Arbitrary ix, Load DW ix e, Arbitrary e) => Arbitrary (Array DW ix e) where+  arbitrary = arbitraryArray arbitrary+instance (ix ~ Ix1, Arbitrary e) => Arbitrary (Array DS ix e) where+  arbitrary = arbitraryArray arbitrary+instance (Arbitrary ix, Index ix, Arbitrary e) => Arbitrary (Array B ix e) where+  arbitrary = arbitraryArray arbitrary+instance (Arbitrary ix, Index ix, Arbitrary e) => Arbitrary (Array BL ix e) where+  arbitrary = arbitraryArray arbitrary+instance (Arbitrary ix, Index ix, Arbitrary e, NFData e) => Arbitrary (Array BN ix e) where+  arbitrary = arbitraryArray arbitrary+instance (Arbitrary ix, Index ix, Arbitrary e, Prim e) => Arbitrary (Array P ix e) where+  arbitrary = arbitraryArray arbitrary+instance (Arbitrary ix, Index ix, Arbitrary e, Storable e) => Arbitrary (Array S ix e) where+  arbitrary = arbitraryArray arbitrary+instance (Arbitrary ix, Index ix, Arbitrary e, Unbox e) => Arbitrary (Array U ix e) where+  arbitrary = arbitraryArray arbitrary+instance (Arbitrary ix, Load L ix e, Arbitrary e) => Arbitrary (Array L ix e) where+  arbitrary = arbitraryArray arbitrary  instance (Arbitrary ix, Load r ix e, Arbitrary e) => Arbitrary (ArrTiny r ix e) where   arbitrary = ArrTiny <$> arbitraryArray (liftSz (`mod` 10) <$> arbitrary) --- | Arbitrary small and possibly empty array. Computation strategy can be either `Seq` or `Par`.-instance (Arbitrary ix, Load r ix e, Arbitrary e) =>-         Arbitrary (ArrTinyNE r ix e) where+-- | Arbitrary small and possibly empty array.+instance+  (Arbitrary ix, Load r ix e, Arbitrary e)+  => Arbitrary (ArrTinyNE r ix e)+  where   arbitrary = ArrTinyNE <$> arbitraryArray (liftSz (succ . (`mod` 10)) <$> arbitrary) -instance (Arbitrary ix, Load r ix e, Arbitrary e) =>-         Arbitrary (ArrNE r ix e) where+instance+  (Arbitrary ix, Load r ix e, Arbitrary e)+  => Arbitrary (ArrNE r ix e)+  where   arbitrary = ArrNE <$> arbitraryArray (unSzNE <$> arbitrary) --instance (Arbitrary ix, Load r ix e, Arbitrary e) =>-         Arbitrary (ArrIx r ix e) where+instance+  (Arbitrary ix, Load r ix e, Arbitrary e)+  => Arbitrary (ArrIx r ix e)+  where   arbitrary = do     SzIx sz ix <- arbitrary     func <- arbitrary     comp <- arbitrary     return $ ArrIx (makeArrayLinear comp sz func) ix - data ArrDW ix e = ArrDW (Array D ix e) (Array DW ix e) -instance (Show ix, Index ix, Ragged L ix e, Load DW ix e, Show e) =>-         Show (ArrDW ix e) where+instance+  (Show ix, Index ix, Ragged L ix e, Load DW ix e, Show e)+  => Show (ArrDW ix e)+  where   show (ArrDW d dw) =-    "Delayed:\n" ++-    show d ++-    "\nCorresponding Windowed:\n" ++-    --show dw ++-    windowInfo+    "Delayed:\n"+      ++ show d+      ++ "\nCorresponding Windowed:\n"+      +++      -- show dw +++      windowInfo     where       windowInfo =         maybe           "\n No Window"-          (\Window {windowStart, windowSize} ->-             "\n With Window starting index (" ++-             show windowStart ++ ") and size (" ++ show windowSize ++ ")") $-        getWindow dw+          ( \Window{windowStart, windowSize} ->+              "\n With Window starting index ("+                ++ show windowStart+                ++ ") and size ("+                ++ show windowSize+                ++ ")"+          )+          $ getWindow dw -instance (Arbitrary ix, CoArbitrary ix, Load DW ix e, Arbitrary e, Typeable e) =>-         Arbitrary (ArrDW ix e) where+instance+  (Arbitrary ix, CoArbitrary ix, Load DW ix e, Arbitrary e, Typeable e)+  => Arbitrary (ArrDW ix e)+  where   arbitrary = do     ArrTiny (arr :: Array D ix e) <- arbitrary     let sz = size arr-    ArrDW arr <$>-      if totalElem sz == 0+    ArrDW arr+      <$> if totalElem sz == 0         then return (makeArray (getComp arr) sz (evaluate' arr))         else do           wix <- flip (liftIndex2 mod) (unSz sz) <$> arbitrary-          wsz <- liftIndex (+1) . flip (liftIndex2 mod) (liftIndex2 (-) (unSz sz) wix) <$> arbitrary+          wsz <- liftIndex (+ 1) . flip (liftIndex2 mod) (liftIndex2 (-) (unSz sz) wix) <$> arbitrary           return $ makeWindowedArray arr wix (Sz wsz) (evaluate' arr)
src/Test/Massiv/Core/Index.hs view
@@ -10,26 +10,31 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -Wno-redundant-constraints #-}-module Test.Massiv.Core.Index-  ( DimIx(..)-  , SzNE(..)-  , SzIx(..)-  , SzTiny(..)-  , ixToList-  , arbitraryIx1-  , toIx++module Test.Massiv.Core.Index (+  DimIx (..),+  SzNE (..),+  SzIx (..),+  SzTiny (..),+  ixToList,+  arbitraryIx1,+  toIx,+   -- * Specs+   -- ** Index-  , specIx1-  , ixSpec-  , ix2UpSpec-  , ixNumSpec+  specIx1,+  ixSpec,+  ix2UpSpec,+  ixNumSpec,+   -- ** Size-  , szNumSpec-  , szSpec+  szNumSpec,+  szSpec,+   -- * Re-exports-  , module Data.Massiv.Core.Index-  ) where+  module Data.Massiv.Core.Index,+) where  import Control.DeepSeq import Control.Exception (throw)@@ -37,16 +42,15 @@ import Data.Foldable as F import Data.Functor.Identity import Data.IORef-import Data.Massiv.Array.Unsafe (Sz(SafeSz))+import Data.Massiv.Array.Unsafe (Sz (SafeSz)) import Data.Massiv.Core.Index import Data.Proxy import Data.Typeable-import GHC.Exception (ErrorCall(ErrorCallWithLocation))+import GHC.Exception (ErrorCall (ErrorCallWithLocation)) import Test.Massiv.Utils - -- | Dimension that is always within bounds of an index-newtype DimIx ix = DimIx Dim deriving Show+newtype DimIx ix = DimIx Dim deriving (Show)  deriving instance Arbitrary Dim @@ -59,11 +63,11 @@ -- prop > \ (neSz :: Sz5) -> totalElem (unSzNE neSz) > 0 newtype SzNE ix = SzNE   { unSzNE :: Sz ix-  } deriving (Show)-+  }+  deriving (Show)  -- | Non-empty size together with an index that is within bounds of that index.-data SzIx ix = SzIx (Sz ix) ix deriving Show+data SzIx ix = SzIx (Sz ix) ix deriving (Show)  instance (Index ix, Arbitrary ix) => Arbitrary (Sz ix) where   arbitrary = do@@ -73,12 +77,12 @@       else return sz  instance (Index ix, Arbitrary ix) => Arbitrary (SzNE ix) where-  arbitrary = SzNE . Sz . liftIndex (+1) . unSz <$> arbitrary+  arbitrary = SzNE . Sz . liftIndex (+ 1) . unSz <$> arbitrary  instance (Index ix, Arbitrary ix) => Arbitrary (Stride ix) where   arbitrary = do     Positive (Small x) <- arbitrary-    Stride . liftIndex ((+1) . (`mod` min 6 x)) <$> arbitrary+    Stride . liftIndex ((+ 1) . (`mod` min 6 x)) <$> arbitrary  instance (Index ix, Arbitrary ix) => Arbitrary (SzIx ix) where   arbitrary = do@@ -86,16 +90,12 @@     -- Make sure index is within bounds:     SzIx sz . flip (liftIndex2 mod) (unSz sz) <$> arbitrary ----newtype SzTiny ix = SzTiny { unSzTiny :: Sz ix }+newtype SzTiny ix = SzTiny {unSzTiny :: Sz ix}   deriving (Show, Eq)  instance (Arbitrary ix, Index ix) => Arbitrary (SzTiny ix) where   arbitrary = SzTiny . liftSz (`mod` 10) <$> arbitrary - instance Arbitrary e => Arbitrary (Border e) where   arbitrary =     oneof@@ -106,7 +106,6 @@       , return Continue       ] - instance Index ix => Arbitrary (DimIx ix) where   arbitrary = do     n <- arbitrary@@ -128,8 +127,9 @@ -- | A fairly slow way to convert from one arbitrary index to another of the same dimension -- -- @since 0.1.0-toIx ::-     forall ix' ix. (Dimensions ix' ~ Dimensions ix, Index ix', Index ix)+toIx+  :: forall ix' ix+   . (Dimensions ix' ~ Dimensions ix, Index ix', Index ix)   => ix   -> ix' toIx ix = F.foldl' setEachIndex zeroIndex [1 .. dimensions (Sz ix)]@@ -175,7 +175,6 @@ instance Function Ix5 where   function = functionMap fromIx5 toIx5 - prop_IsSafeIndex :: Index ix => SzIx ix -> Bool prop_IsSafeIndex (SzIx sz ix) = isSafeIndex sz ix @@ -202,13 +201,15 @@  prop_CountElements :: Index ix => Int -> Sz ix -> Property prop_CountElements thresh sz =-  totalElem sz < thresh ==> totalElem sz ==-  iter zeroIndex (unSz sz) (pureIndex 1) (<) 0 (const (+ 1))+  totalElem sz+    < thresh+    ==> totalElem sz+    == iter zeroIndex (unSz sz) (pureIndex 1) (<) 0 (const (+ 1))  prop_IterMonotonic :: Index ix => Int -> Sz ix -> Property prop_IterMonotonic thresh sz =-  totalElem sz < thresh ==> fst $-  iter (liftIndex succ zeroIndex) (unSz sz) (pureIndex 1) (<) (True, zeroIndex) mono+  (totalElem sz < thresh)+    ==> fst (iter (liftIndex succ zeroIndex) (unSz sz) (pureIndex 1) (<) (True, zeroIndex) mono)   where     mono curIx (prevMono, prevIx) =       let isMono = prevMono && prevIx < curIx@@ -216,18 +217,19 @@  prop_IterMonotonicM :: Index ix => Int -> Sz ix -> Property prop_IterMonotonicM thresh sz =-  totalElem sz < thresh ==> fst $-  runIdentity $ iterM (liftIndex succ zeroIndex) (unSz sz) (pureIndex 1) (<) (True, zeroIndex) mono+  (totalElem sz < thresh)+    ==> fst+    $ runIdentity+    $ iterM (liftIndex succ zeroIndex) (unSz sz) (pureIndex 1) (<) (True, zeroIndex) mono   where     mono curIx (prevMono, prevIx) =       let isMono = prevMono && prevIx < curIx        in return $ isMono `seq` (isMono, curIx) - prop_IterMonotonicBackwards :: Index ix => Int -> Sz ix -> Property prop_IterMonotonicBackwards thresh sz@(Sz szix) =-  totalElem sz < thresh ==> fst $-  iter (liftIndex pred szix) zeroIndex (pureIndex (-1)) (>=) (True, szix) mono+  (totalElem sz < thresh)+    ==> fst (iter (liftIndex pred szix) zeroIndex (pureIndex (-1)) (>=) (True, szix) mono)   where     mono curIx (prevMono, prevIx) =       let isMono = prevMono && prevIx > curIx@@ -235,17 +237,19 @@  prop_IterMonotonicBackwardsM :: Index ix => Int -> Sz ix -> Property prop_IterMonotonicBackwardsM thresh sz@(Sz szix) =-  totalElem sz < thresh ==> fst $-  runIdentity $ iterM (liftIndex pred szix) zeroIndex (pureIndex (-1)) (>=) (True, szix) mono+  (totalElem sz < thresh)+    ==> fst+    $ runIdentity+    $ iterM (liftIndex pred szix) zeroIndex (pureIndex (-1)) (>=) (True, szix) mono   where     mono curIx (prevMono, prevIx) =       let isMono = prevMono && prevIx > curIx        in return $ isMono `seq` (isMono, curIx)  prop_LiftLift2 :: Index ix => ix -> Int -> Bool-prop_LiftLift2 ix delta = liftIndex2 (+) ix (liftIndex (+delta) zeroIndex) ==-                            liftIndex (+delta) ix-+prop_LiftLift2 ix delta =+  liftIndex2 (+) ix (liftIndex (+ delta) zeroIndex)+    == liftIndex (+ delta) ix  prop_BorderRepairSafe :: Index ix => Border ix -> SzNE ix -> ix -> Property prop_BorderRepairSafe border@(Fill defIx) (SzNE sz) ix =@@ -253,64 +257,63 @@ prop_BorderRepairSafe border (SzNE sz) ix =   not (isSafeIndex sz ix) ==> isSafeIndex sz (handleBorderIndex border sz id ix) - prop_GetDropInsert :: Index ix => DimIx ix -> ix -> Property prop_GetDropInsert (DimIx dim) ix =   property $-  flip shouldReturn ix $ do-    i <- getDimM ix dim-    ixL <- dropDimM ix dim-    insertDimM ixL dim i+    flip shouldReturn ix $ do+      i <- getDimM ix dim+      ixL <- dropDimM ix dim+      insertDimM ixL dim i  prop_PullOutInsert :: Index ix => DimIx ix -> ix -> Property prop_PullOutInsert (DimIx dim) ix =   property $-  flip shouldReturn ix $ do-    (i, ixL) <- pullOutDimM ix dim-    insertDimM ixL dim i+    flip shouldReturn ix $ do+      (i, ixL) <- pullOutDimM ix dim+      insertDimM ixL dim i  prop_getDimException :: (Typeable ix, Index ix) => Dim -> ix -> Property prop_getDimException d ix =-  (d <= 0 || d > dimensions (Just ix)) ==>-  assertExceptionIO (== IndexDimensionException ix d) (getDimM ix d)+  (d <= 0 || d > dimensions (Just ix))+    ==> assertDeepExceptionIO (== IndexDimensionException ix d) (getDimM ix d)  prop_setDimException :: (Typeable ix, Index ix) => Dim -> ix -> Int -> Property prop_setDimException d ix i =-  (d <= 0 || d > dimensions (Just ix)) ==>-  assertExceptionIO (== IndexDimensionException ix d) (setDimM ix d i)+  (d <= 0 || d > dimensions (Just ix))+    ==> assertDeepExceptionIO (== IndexDimensionException ix d) (setDimM ix d i)  prop_PullOutDimException :: (Typeable ix, Index ix) => Dim -> ix -> Property prop_PullOutDimException d ix =-  (d <= 0 || d > dimensions (Just ix)) ==>-  assertExceptionIO (== IndexDimensionException ix d) (pullOutDimM ix d)+  (d <= 0 || d > dimensions (Just ix))+    ==> assertDeepExceptionIO (== IndexDimensionException ix d) (pullOutDimM ix d) -prop_InsertDimException ::-     forall ix. (Typeable (Lower ix), Index ix)+prop_InsertDimException+  :: forall ix+   . (Typeable (Lower ix), Index ix)   => Dim   -> Lower ix   -> Int   -> Property prop_InsertDimException d ix i =-  (d <= 0 || d > dimensions resIO) ==> assertExceptionIO (== IndexDimensionException ix d) resIO+  (d <= 0 || d > dimensions resIO) ==> assertDeepExceptionIO (== IndexDimensionException ix d) resIO   where     resIO = insertDimM ix d i :: IO ix - prop_UnconsGetDrop :: (Index (Lower ix), Index ix) => ix -> Property prop_UnconsGetDrop ix =   property $-  flip shouldReturn (unconsDim ix) $ do-    i <- getDimM ix (dimensions (Just ix))-    ixL <- dropDimM ix (dimensions (Just ix))-    return (i, ixL)+    flip shouldReturn (unconsDim ix) $ do+      i <- getDimM ix (dimensions (Just ix))+      ixL <- dropDimM ix (dimensions (Just ix))+      return (i, ixL)  prop_UnsnocGetDrop :: (Index (Lower ix), Index ix) => ix -> Property prop_UnsnocGetDrop ix =   property $-  flip shouldReturn (unsnocDim ix) $ do-    i <- getDimM ix 1-    ixL <- dropDimM ix 1-    return (ixL, i)+    flip shouldReturn (unsnocDim ix) $ do+      i <- getDimM ix 1+      ixL <- dropDimM ix 1+      return (ixL, i)  prop_SetAll :: Index ix => ix -> Property prop_SetAll ix = property $ do@@ -320,77 +323,72 @@     replaceDims = foldM (\cix d -> getDimM ix d >>= setDimM cix d) zeroIndex     dims = [1 .. dimensions (Just ix)] :: [Dim] - prop_SetGet :: Index ix => ix -> DimIx ix -> Int -> Property prop_SetGet ix (DimIx dim) n = n === getDim' (setDim' ix dim n) dim -- prop_BorderIx1 :: Positive Int -> Border Char -> Fun Ix1 Char -> SzNE Ix1 -> Ix1 -> Property prop_BorderIx1 (Positive period) border getVal (SzNE sz) ix =   if isSafeIndex sz ix     then val === apply getVal ix     else case border of-           Fill defVal -> val === defVal-           Wrap ->-             val ===-             handleBorderIndex-               border-               sz-               (apply getVal)-               (liftIndex2 (+) (liftIndex (* period) (unSz sz)) ix)-           Edge ->-             if ix < 0-               then val === apply getVal (liftIndex (max 0) ix)-               else val === apply getVal (liftIndex2 min (liftIndex (subtract 1) (unSz sz)) ix)-           Reflect ->-             val ===-             handleBorderIndex-               border-               sz-               (apply getVal)-               (liftIndex2 (+) (liftIndex (* (2 * signum ix * period)) (unSz sz)) ix)-           Continue ->-             val ===-             handleBorderIndex-               Reflect-               sz-               (apply getVal)-               (if ix < 0-                  then ix - 1-                  else ix + 1)+      Fill defVal -> val === defVal+      Wrap ->+        val+          === handleBorderIndex+            border+            sz+            (apply getVal)+            (liftIndex2 (+) (liftIndex (* period) (unSz sz)) ix)+      Edge ->+        if ix < 0+          then val === apply getVal (liftIndex (max 0) ix)+          else val === apply getVal (liftIndex2 min (liftIndex (subtract 1) (unSz sz)) ix)+      Reflect ->+        val+          === handleBorderIndex+            border+            sz+            (apply getVal)+            (liftIndex2 (+) (liftIndex (* (2 * signum ix * period)) (unSz sz)) ix)+      Continue ->+        val+          === handleBorderIndex+            Reflect+            sz+            (apply getVal)+            ( if ix < 0+                then ix - 1+                else ix + 1+            )   where     val = handleBorderIndex border sz (apply getVal) ix --prop_BinaryNumIx ::-  (Num ix, Index ix) => (forall n . Num n => n -> n -> n) -> ix -> ix -> Property+prop_BinaryNumIx+  :: (Num ix, Index ix) => (forall n. Num n => n -> n -> n) -> ix -> ix -> Property prop_BinaryNumIx f ix1 ix2 = zipWith f (ixToList ix1) (ixToList ix2) === ixToList (f ix1 ix2) -prop_UnaryNumIx ::-  (Num ix, Index ix) => (forall n . Num n => n -> n) -> ix -> Property+prop_UnaryNumIx+  :: (Num ix, Index ix) => (forall n. Num n => n -> n) -> ix -> Property prop_UnaryNumIx f ix = map f (ixToList ix) === ixToList (f ix) -prop_BinaryNumSz ::-  (Num ix, Index ix) => (forall n . Num n => n -> n -> n) -> Sz ix -> Sz ix -> Property+prop_BinaryNumSz+  :: (Num ix, Index ix) => (forall n. Num n => n -> n -> n) -> Sz ix -> Sz ix -> Property prop_BinaryNumSz f sz1 sz2 =   zipWith f' (ixToList (unSz sz1)) (ixToList (unSz sz2)) === ixToList (unSz (f sz1 sz2))   where     f' x y = max 0 (f x y) -prop_UnaryNumSz ::-  (Num ix, Index ix) => (forall n . Num n => n -> n) -> Sz ix -> Property+prop_UnaryNumSz+  :: (Num ix, Index ix) => (forall n. Num n => n -> n) -> Sz ix -> Property prop_UnaryNumSz f sz = map f' (ixToList (unSz sz)) === ixToList (unSz (f sz))   where     f' = max 0 . f -- prop_IterLinearM :: Index ix => Sz ix -> NonNegative Int -> Positive Int -> Property prop_IterLinearM sz (NonNegative start) (Positive increment) = property $ do   xs <- iterLinearM sz start (totalElem sz) increment (<) [] $ \i ix acc -> do     toLinearIndex sz ix `shouldBe` i-    pure (i:acc)+    pure (i : acc)   reverse xs `shouldBe` [start, start + increment .. totalElem sz - 1]  prop_IterLinearM_ :: Index ix => Sz ix -> NonNegative Int -> Positive Int -> Property@@ -398,7 +396,7 @@   ref <- newIORef []   iterLinearM_ sz start (totalElem sz) increment (<) $ \i ix -> do     toLinearIndex sz ix `shouldBe` i-    modifyIORef' ref (i:)+    modifyIORef' ref (i :)   xs <- readIORef ref   reverse xs `shouldBe` [start, start + increment .. totalElem sz - 1] @@ -412,17 +410,22 @@   ixNumSpec @Ix1   it "Border" $ property prop_BorderIx1 --ixSpec ::-     forall ix. (Typeable (Lower ix), Arbitrary (Lower ix), Typeable ix, Index ix, Arbitrary ix-                , IsIndexDimension ix (Dimensions ix))+ixSpec+  :: forall ix+   . ( Typeable (Lower ix)+     , Arbitrary (Lower ix)+     , Typeable ix+     , Index ix+     , Arbitrary ix+     , IsIndexDimension ix (Dimensions ix)+     )   => Spec ixSpec = do   let threshold = 50000   describe "Safety" $ do     prop "IsSafeIndex" $ prop_IsSafeIndex @ix     prop "RepairSafeIx" $ prop_RepairSafeIx @ix-  describe "Lifting" $+  describe "Lifting" $ do     prop "Lift/Lift2" $ prop_LiftLift2 @ix   describe "Linear" $ do     prop "ToFromLinearIndex" $ prop_ToFromLinearIndex @ix@@ -433,7 +436,7 @@     prop "MonotonicBackwards" $ prop_IterMonotonicBackwards @ix threshold     prop "MonotonicM" $ prop_IterMonotonicM @ix threshold     prop "MonotonicBackwardsM" $ prop_IterMonotonicBackwardsM @ix threshold-  describe "Border" $+  describe "Border" $ do     prop "BorderRepairSafe" $ prop_BorderRepairSafe @ix   describe "SetGetDrop" $ do     prop "SetAll" $ prop_SetAll @ix@@ -454,39 +457,41 @@     prop "SetInnerDimension" $       \(ix :: ix) i -> snocDim (initDim ix) i === setDimension ix Dim1 i     prop "SetOuterDimension" $-      \(ix :: ix) i -> consDim i (tailDim ix) ===-                       setDimension ix (DimN :: Dimension (Dimensions ix)) i+      \(ix :: ix) i ->+        consDim i (tailDim ix)+          === setDimension ix (DimN :: Dimension (Dimensions ix)) i     prop "DropInnerDimension" $ \(ix :: ix) -> initDim ix === dropDimension ix Dim1     prop "DropOuterDimension" $       \(ix :: ix) -> tailDim ix === dropDimension ix (DimN :: Dimension (Dimensions ix))     prop "InsertInnerDimension" $       \(ixl :: Lower ix) i -> (snocDim ixl i :: ix) === insertDimension ixl Dim1 i     prop "InsertOuterDimension" $-      \(ixl :: Lower ix) i -> (consDim i ixl :: ix) ===-                               insertDimension ixl (DimN :: Dimension (Dimensions ix)) i+      \(ixl :: Lower ix) i ->+        (consDim i ixl :: ix)+          === insertDimension ixl (DimN :: Dimension (Dimensions ix)) i     prop "PullOutInnerDimension" $       \(ix :: ix) -> unsnocDim ix === uncurry (flip (,)) (pullOutDimension ix Dim1)     prop "PullInnerOuterDimension" $-      \(ix :: ix) -> unconsDim ix ===-                               pullOutDimension ix (DimN :: Dimension (Dimensions ix))+      \(ix :: ix) ->+        unconsDim ix+          === pullOutDimension ix (DimN :: Dimension (Dimensions ix))    describe "NFData" $ do-    it "rnf" $ property $ \ (ix :: ix) -> rnf ix `shouldBe` ()-    it "throws exception" $ property $ \ (DimIx d :: DimIx ix) (ix :: ix) ->-      assertException (== ExpectedException) (setDim' ix d (throw ExpectedException))-+    it "rnf" $ property $ \(ix :: ix) -> rnf ix `shouldBe` ()+    it "throws exception" $ property $ \(DimIx d :: DimIx ix) (ix :: ix) ->+      assertDeepException (== ExpectedException) (setDim' ix d (throw ExpectedException)) -ix2UpSpec ::-     forall ix. (Index ix, Index (Lower ix), Arbitrary ix, Arbitrary (Lower ix), Typeable (Lower ix))+ix2UpSpec+  :: forall ix+   . (Index ix, Index (Lower ix), Arbitrary ix, Arbitrary (Lower ix), Typeable (Lower ix))   => Spec ix2UpSpec =   describe "Higher/Lower" $ do     prop "UnconsGetDrop" $ prop_UnconsGetDrop @ix     prop "UnsnocGetDrop" $ prop_UnsnocGetDrop @ix - -- | Spec that validates the Num instance for any `Index ix => ix`-ixNumSpec :: forall ix . (Typeable ix, Num ix, Index ix, Arbitrary ix) => Spec+ixNumSpec :: forall ix. (Typeable ix, Num ix, Index ix, Arbitrary ix) => Spec ixNumSpec = do   describe ("Num (" ++ showsType @ix ")") $ do     prop "(+)" $ prop_BinaryNumIx @ix (+)@@ -495,52 +500,53 @@     prop "negate" $ prop_UnaryNumIx @ix negate     prop "abs" $ prop_UnaryNumIx @ix abs     prop "signum" $ prop_UnaryNumIx @ix signum-    prop "fromInteger" $ \ (i :: Int) ->+    prop "fromInteger" $ \(i :: Int) ->       (fromIntegral i :: ix) === liftIndex (const i) zeroIndex   describe "Constants" $ do     it "zeroIndex" $ (zeroIndex :: ix) `shouldBe` 0     it "oneIndex" $ (oneIndex :: ix) `shouldBe` 1  -- | Spec that validates the Num instance for any `Index ix => Sz ix`-szNumSpec :: forall ix . (Typeable ix, Num ix, Index ix, Arbitrary ix) => Spec+szNumSpec :: forall ix. (Typeable ix, Num ix, Index ix, Arbitrary ix) => Spec szNumSpec = do   describe ("Num (" ++ showsType @(Sz ix) ")") $ do     prop "(+)" $ prop_BinaryNumSz @ix (+)     prop "(-)" $ prop_BinaryNumSz @ix (-)     prop "(*)" $ prop_BinaryNumSz @ix (*)     prop "negate (throws error on non-zero)" $ \sz ->-      sz /= zeroSz ==> assertException-                       (\(ErrorCallWithLocation err loc) -> err `deepseq` loc `deepseq` True)-                       (negate sz :: Sz ix)+      sz+        /= zeroSz+        ==> assertDeepException+          (\(ErrorCallWithLocation err loc) -> err `deepseq` loc `deepseq` True)+          (negate sz :: Sz ix)      prop "abs" $ prop_UnaryNumSz @ix abs     prop "signum" $ prop_UnaryNumSz @ix signum-    prop "fromInteger" $ \ (i :: Int) ->+    prop "fromInteger" $ \(i :: Int) ->       (fromIntegral i :: Sz ix) === SafeSz (pureIndex (max 0 i))-    prop "fromIx" $ \ (ix :: ix) -> unSz (Sz ix) === liftIndex (max 0) ix+    prop "fromIx" $ \(ix :: ix) -> unSz (Sz ix) === liftIndex (max 0) ix   describe "Constants" $ do     it "zeroSz" $ (zeroSz :: Sz ix) `shouldBe` 0     it "oneSz" $ (oneSz :: Sz ix) `shouldBe` 1 - prop_PullOutInsertSize :: Index ix => DimIx ix -> Sz ix -> Property prop_PullOutInsertSize (DimIx dim) sz =   either throw (sz ===) $ do     (i, szL) <- pullOutSzM sz dim     insertSzM szL dim i --szSpec ::-     forall ix. (Index ix, Arbitrary ix)+szSpec+  :: forall ix+   . (Index ix, Arbitrary ix)   => Spec szSpec = do   describe "Higher/Lower" $ do-    prop "LiftSzNegate" $ \ (sz :: Sz ix) -> liftSz negate sz === zeroSz-    prop "UnconsCons" $ \ (sz :: Sz ix) -> sz === uncurry consSz (unconsSz sz)-    prop "UnsnocSnoc" $ \ (sz :: Sz ix) -> sz === uncurry snocSz (unsnocSz sz)+    prop "LiftSzNegate" $ \(sz :: Sz ix) -> liftSz negate sz === zeroSz+    prop "UnconsCons" $ \(sz :: Sz ix) -> sz === uncurry consSz (unconsSz sz)+    prop "UnsnocSnoc" $ \(sz :: Sz ix) -> sz === uncurry snocSz (unsnocSz sz)     prop "PullOutInsert" $ prop_PullOutInsertSize @ix     prop "SetSzInnerSnoc" $-      \ (sz :: Sz ix) i -> setSzM sz 1 i `shouldReturn` snocSz (fst $ unsnocSz sz) i+      \(sz :: Sz ix) i -> setSzM sz 1 i `shouldReturn` snocSz (fst $ unsnocSz sz) i   describe "Number of Elements" $ do     prop "TotalElem" $       \(sz :: Sz ix) -> totalElem sz === foldlIndex (*) 1 (unSz sz)
src/Test/Massiv/Core/Mutable.hs view
@@ -1,41 +1,41 @@-{-# LANGUAGE BangPatterns #-} {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}-module Test.Massiv.Core.Mutable-  ( -- * Spec for Mutable instance-    unsafeMutableSpec-  , prop_UnsafeNewMsize-  , prop_UnsafeThawFreeze-  , prop_UnsafeInitializeNew-  , prop_UnsafeArrayLinearCopy++module Test.Massiv.Core.Mutable (+  -- * Spec for Mutable instance+  unsafeMutableSpec,+  prop_UnsafeNewMsize,+  prop_UnsafeThawFreeze,+  prop_UnsafeInitializeNew,+  prop_UnsafeArrayLinearCopy,+   -- ** Properties that aren't valid for boxed-  , unsafeMutableUnboxedSpec-  , prop_UnsafeInitialize-  ) where+  unsafeMutableUnboxedSpec,+  prop_UnsafeInitialize,+) where  import Data.Massiv.Array as A import Data.Massiv.Array.Unsafe import Test.Massiv.Core.Common import Test.Massiv.Utils ---prop_UnsafeNewMsize ::-     forall r ix e.-     (Arbitrary ix, Index ix, Manifest r e)+prop_UnsafeNewMsize+  :: forall r ix e+   . (Arbitrary ix, Index ix, Manifest r e)   => Property-prop_UnsafeNewMsize = property $ \ sz -> do+prop_UnsafeNewMsize = property $ \sz -> do   marr :: MArray RealWorld r ix e <- unsafeNew sz   sz `shouldBe` sizeOfMArray marr -prop_UnsafeNewLinearWriteRead ::-     forall r ix e.-     (Eq e, Show e, Manifest r e, Index ix, Arbitrary ix, Arbitrary e)+prop_UnsafeNewLinearWriteRead+  :: forall r ix e+   . (Eq e, Show e, Manifest r e, Index ix, Arbitrary ix, Arbitrary e)   => Property-prop_UnsafeNewLinearWriteRead = property $ \ (SzIx sz ix) e1 e2 -> do+prop_UnsafeNewLinearWriteRead = property $ \(SzIx sz ix) e1 e2 -> do   marr :: MArray RealWorld r ix e <- unsafeNew sz   let i = toLinearIndex sz ix   unsafeLinearWrite marr i e1@@ -43,17 +43,16 @@   unsafeLinearModify marr (\ !_ -> pure e2) i `shouldReturn` e1   unsafeLinearRead marr i `shouldReturn` e2 --prop_UnsafeThawFreeze ::-     forall r ix e.-     (Eq (Array r ix e), Show (Array r ix e), Index ix, Manifest r e)-  => Array r ix e -> Property+prop_UnsafeThawFreeze+  :: forall r ix e+   . (Eq (Array r ix e), Show (Array r ix e), Index ix, Manifest r e)+  => Array r ix e+  -> Property prop_UnsafeThawFreeze arr = arr === runST (unsafeFreeze (getComp arr) =<< unsafeThaw arr) --prop_UnsafeInitializeNew ::-     forall r ix e.-     ( Eq (Array r ix e)+prop_UnsafeInitializeNew+  :: forall r ix e+   . ( Eq (Array r ix e)      , Show (Array r ix e)      , Show e      , Arbitrary e@@ -64,12 +63,12 @@   => Property prop_UnsafeInitializeNew =   property $ \comp sz e ->-    (compute (A.replicate comp sz e :: Array DL ix e) :: Array r ix e) ===-    runST (unsafeFreeze comp =<< initializeNew (Just e) sz)+    (compute (A.replicate comp sz e :: Array DL ix e) :: Array r ix e)+      === runST (unsafeFreeze comp =<< initializeNew (Just e) sz) -prop_UnsafeInitialize ::-     forall r ix e.-     ( Eq (Array r ix e)+prop_UnsafeInitialize+  :: forall r ix e+   . ( Eq (Array r ix e)      , Show (Array r ix e)      , Arbitrary ix      , Index ix@@ -84,25 +83,27 @@       marr2 :: MArray s r ix e <- initializeNew Nothing sz       (===) <$> unsafeFreeze comp marr1 <*> unsafeFreeze comp marr2 --prop_UnsafeLinearCopy ::-     forall r ix e. (Eq (Array r ix e), Show (Array r ix e), Index ix, Manifest r e)+prop_UnsafeLinearCopy+  :: forall r ix e+   . (Eq (Array r ix e), Show (Array r ix e), Index ix, Manifest r e)   => Array r ix e   -> Property prop_UnsafeLinearCopy arr =-  (arr, arr) ===-  runST-    (do let sz = size arr-        marrs <- thawS arr-        marrd <- unsafeNew sz-        unsafeLinearCopy marrs 0 marrd 0 (Sz (totalElem sz))-        arrd <- unsafeFreeze (getComp arr) marrd-        arrs <- unsafeFreeze (getComp arr) marrs-        pure (arrs, arrd))+  (arr, arr)+    === runST+      ( do+          let sz = size arr+          marrs <- thawS arr+          marrd <- unsafeNew sz+          unsafeLinearCopy marrs 0 marrd 0 (Sz (totalElem sz))+          arrd <- unsafeFreeze (getComp arr) marrd+          arrs <- unsafeFreeze (getComp arr) marrs+          pure (arrs, arrd)+      ) -prop_UnsafeLinearCopyPart ::-     forall r ix e.-     ( Eq (Vector r e)+prop_UnsafeLinearCopyPart+  :: forall r ix e+   . ( Eq (Vector r e)      , Show (Vector r e)      , Eq (Array r ix e)      , Show (Array r ix e)@@ -128,22 +129,24 @@         unsafeLinearCopy marrs i marrd j k         (,) <$> unsafeFreeze (getComp arr) marrs <*> unsafeFreeze (getComp arr) marrd --prop_UnsafeArrayLinearCopy ::-     forall r ix e. (Eq (Array r ix e), Show (Array r ix e), Index ix, Manifest r e)+prop_UnsafeArrayLinearCopy+  :: forall r ix e+   . (Eq (Array r ix e), Show (Array r ix e), Index ix, Manifest r e)   => Array r ix e   -> Property prop_UnsafeArrayLinearCopy arr =-  arr ===-  runST-    (do let sz = size arr-        marr <- unsafeNew sz-        unsafeArrayLinearCopy arr 0 marr 0 (Sz (totalElem sz))-        unsafeFreeze (getComp arr) marr)-+  arr+    === runST+      ( do+          let sz = size arr+          marr <- unsafeNew sz+          unsafeArrayLinearCopy arr 0 marr 0 (Sz (totalElem sz))+          unsafeFreeze (getComp arr) marr+      ) -prop_UnsafeArrayLinearCopyPart ::-     forall r ix e. (Eq (Vector r e), Show (Vector r e), Index ix, Manifest r e)+prop_UnsafeArrayLinearCopyPart+  :: forall r ix e+   . (Eq (Vector r e), Show (Vector r e), Index ix, Manifest r e)   => ArrIx r ix e   -> NonNegative Ix1   -> Ix1@@ -162,9 +165,9 @@         unsafeArrayLinearCopy arr i marr j k         unsafeFreeze (getComp arr) marr -prop_UnsafeLinearSet ::-     forall r ix e.-     ( Eq (Vector r e)+prop_UnsafeLinearSet+  :: forall r ix e+   . ( Eq (Vector r e)      , Show (Vector r e)      , Index ix      , Manifest r e@@ -175,8 +178,8 @@   -> e   -> Property prop_UnsafeLinearSet comp (SzIx sz ix) (NonNegative delta) e =-  compute (A.replicate Seq k e :: Array DL Ix1 e) ===-  slice' i k (flatten (arrd :: Array r ix e))+  compute (A.replicate Seq k e :: Array DL Ix1 e)+    === slice' i k (flatten (arrd :: Array r ix e))   where     i = toLinearIndex sz ix     k = Sz (totalElem sz - i - delta)@@ -186,9 +189,9 @@         unsafeLinearSet marrd i k e         unsafeFreeze comp marrd -prop_UnsafeLinearShrink ::-     forall r ix e.-     ( Eq (Vector r e)+prop_UnsafeLinearShrink+  :: forall r ix e+   . ( Eq (Vector r e)      , Show (Vector r e)      , Manifest r e      , Index ix@@ -207,9 +210,9 @@         marr' <- unsafeLinearShrink marr sz'         unsafeFreeze (getComp arr) marr' -prop_UnsafeLinearGrow ::-     forall r ix e.-     ( Eq (Array r ix e)+prop_UnsafeLinearGrow+  :: forall r ix e+   . ( Eq (Array r ix e)      , Show (Array r ix e)      , Eq (Vector r e)      , Show (Vector r e)@@ -220,8 +223,10 @@   -> e   -> Property prop_UnsafeLinearGrow (ArrIx arr ix) e =-  slice' 0 k (flatten arr) === slice' 0 k (flatten arrGrown) .&&.-  arrCopied === arrGrown+  slice' 0 k (flatten arr)+    === slice' 0 k (flatten arrGrown)+    .&&. arrCopied+    === arrGrown   where     sz = size arr     sz' = Sz (liftIndex2 (+) (unSz sz) ix)@@ -237,9 +242,9 @@           unsafeLinearSet marrCopied (totalElem sz) (Sz (totalElem sz' - totalElem sz)) e         (,) <$> unsafeFreeze (getComp arr) marrCopied <*> unsafeFreeze (getComp arr) marrGrown --prop_UnsafeLinearSliceMArray ::-     forall r ix e. (HasCallStack, Index ix, Manifest r e, Eq (Vector r e), Show (Vector r e))+prop_UnsafeLinearSliceMArray+  :: forall r ix e+   . (HasCallStack, Index ix, Manifest r e, Eq (Vector r e), Show (Vector r e))   => Array r ix e   -> Property prop_UnsafeLinearSliceMArray arr =@@ -254,10 +259,9 @@       i <- chooseInt (0, n - k)       pure (i, Sz k) --unsafeMutableSpec ::-     forall r ix e.-     ( Eq (Vector r e)+unsafeMutableSpec+  :: forall r ix e+   . ( Eq (Vector r e)      , Show (Vector r e)      , Eq (Array r ix e)      , Show (Array r ix e)@@ -265,6 +269,7 @@      , Show e      , Eq e      , Load r ix e+     , Arbitrary (Array r ix e)      , Arbitrary e      , Arbitrary ix      , Typeable e@@ -285,9 +290,9 @@     prop "UnsafeLinearGrow" $ prop_UnsafeLinearGrow @r @ix @e     prop "UnsafeLinearSliceMArray" $ prop_UnsafeLinearSliceMArray @r @ix @e -unsafeMutableUnboxedSpec ::-     forall r ix e.-     ( Typeable e+unsafeMutableUnboxedSpec+  :: forall r ix e+   . ( Typeable e      , Eq (Array r ix e)      , Show (Array r ix e)      , Index ix@@ -297,4 +302,5 @@   => Spec unsafeMutableUnboxedSpec =   describe ("Manifest Unboxed (" ++ showsArrayType @r @ix @e ") (Unsafe)") $-    it "UnsafeInitialize" $ prop_UnsafeInitialize @r @ix @e+    it "UnsafeInitialize" $+      prop_UnsafeInitialize @r @ix @e
src/Test/Massiv/Utils.hs view
@@ -1,98 +1,112 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE CPP #-}-{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}-module Test.Massiv.Utils-  ( showsType-  , showsArrayType-  , assertException-  , assertExceptionIO-  , assertSomeException-  , assertSomeExceptionIO-  , toStringException-  , selectErrorCall-  , ExpectedException(..)-  , applyFun2Compat-  , expectProp-  , propIO++module Test.Massiv.Utils (+  showsType,+  showsArrayType,+  assertDeepException,+  assertDeepExceptionIO,+  assertSomeException,+  assertSomeExceptionIO,+  toStringException,+  selectErrorCall,+  ExpectedException (..),+  applyFun2Compat,+  expectProp,+  propIO,+  specLaws,+   -- * Epsilon comparison-  , epsilonExpect-  , epsilonFoldableExpect-  , epsilonMaybeEq-  , epsilonEq-  , epsilonEqDouble-  , epsilonEqFloat-  , module X-  ) where+  epsilonExpect,+  epsilonFoldableExpect,+  epsilonMaybeEq,+  epsilonEq,+  epsilonEqDouble,+  epsilonEqFloat,+  module X,+) where -import qualified Data.Foldable as F+import Control.DeepSeq as X (NFData, deepseq)+import Control.Exception (ErrorCall (..)) import Control.Monad as X import Control.Monad.ST as X+import qualified Data.Foldable as F import Data.Maybe as X (fromMaybe, isJust, isNothing) import Data.Typeable as X-import Test.QuickCheck as X hiding ((.&.))-import Test.QuickCheck.Monadic as X import Test.Hspec as X import Test.Hspec.QuickCheck as X+import Test.QuickCheck as X hiding ((.&.))+import Test.QuickCheck.Classes.Base as X import Test.QuickCheck.Function as X-import Control.DeepSeq as X (NFData, deepseq)-import Control.Exception (ErrorCall (..))-import UnliftIO.Exception (Exception(..), SomeException, catch, catchAny)+import Test.QuickCheck.Monadic as X+import UnliftIO.Exception (Exception (..), SomeException, catch, catchAny) #if !MIN_VERSION_base(4,11,0) import Data.Semigroup as X ((<>)) #endif +specLaws :: HasCallStack => Laws -> Spec+specLaws laws =+  describe (lawsTypeclass laws) $+    mapM_ (uncurry prop) (lawsProperties laws)  -- | Use Typeable to show the type.-showsType :: forall t . Typeable t => ShowS+showsType :: forall t. Typeable t => ShowS showsType = showsTypeRep (typeRep (Proxy :: Proxy t))  -- | Use Typeable to show the array type-showsArrayType :: forall r ix e . (Typeable r, Typeable ix, Typeable e) => ShowS+showsArrayType :: forall r ix e. (Typeable r, Typeable ix, Typeable e) => ShowS showsArrayType =   ("Array " ++) . showsType @r . (" (" ++) . showsType @ix . (") " ++) . showsType @e --assertException ::-     (Testable b, NFData a, Exception exc)-  => (exc -> b) -- ^ Return True if that is the exception that was expected-  -> a -- ^ Value that should throw an exception, when fully evaluated-  -> Property-assertException isExc = assertExceptionIO isExc . pure-- assertSomeException :: NFData a => a -> Property assertSomeException = assertSomeExceptionIO . pure +assertSomeExceptionIO :: NFData a => IO a -> Property+assertSomeExceptionIO action =+  monadicIO $+    run $+      catchAny+        ( do+            res <- action+            res `deepseq` return (counterexample "Did not receive an exception" False)+        )+        (\exc -> displayException exc `deepseq` return (property True)) -assertExceptionIO ::-     (Testable b, NFData a, Exception exc)-  => (exc -> b) -- ^ Return True if that is the exception that was expected-  -> IO a -- ^ IO Action that should throw an exception+#if !MIN_VERSION_QuickCheck(2,15,0)+assertDeepException+  :: (Testable b, NFData a, Exception exc)+  => (exc -> b)+  -- ^ Return True if that is the exception that was expected+  -> a+  -- ^ Value that should throw an exception, when fully evaluated   -> Property-assertExceptionIO isExc action =-  monadicIO $-  run $-  catch-    (do res <- action-        res `deepseq` return (counterexample "Did not receive an exception" False))-    (\exc -> displayException exc `deepseq` return (property (isExc exc)))+assertDeepException isExc = assertDeepExceptionIO isExc . pure -assertSomeExceptionIO :: NFData a => IO a -> Property-assertSomeExceptionIO action =+assertDeepExceptionIO+  :: (Testable b, NFData a, Exception exc)+  => (exc -> b)+  -- ^ Return True if that is the exception that was expected+  -> IO a+  -- ^ IO Action that should throw an exception+  -> Property+assertDeepExceptionIO isExc action =   monadicIO $-  run $-  catchAny-    (do res <- action-        res `deepseq` return (counterexample "Did not receive an exception" False))-    (\exc -> displayException exc `deepseq` return (property True))+    run $+      catch+        ( do+            res <- action+            res `deepseq` return (counterexample "Did not receive an exception" False)+        )+        (\exc -> displayException exc `deepseq` return (property (isExc exc))) +#endif  toStringException :: Either SomeException a -> Either String a toStringException = either (Left . displayException) Right - selectErrorCall :: ErrorCall -> Bool selectErrorCall = \case   ErrorCallWithLocation err loc -> err `deepseq` loc `deepseq` True@@ -101,7 +115,6 @@  instance Exception ExpectedException - applyFun2Compat :: Fun (a, b) c -> (a -> b -> c) #if MIN_VERSION_QuickCheck(2,10,0) applyFun2Compat = applyFun2@@ -120,36 +133,39 @@ -- | Convert a Testable to a quickcheck Property. Works well with hspec expectations as well -- -- @since 1.7.0-propIO :: (Testable a) => IO a -> Property+propIO :: Testable a => IO a -> Property propIO action = monadicIO $ run action --epsilonExpect ::-     (HasCallStack, Show a, RealFloat a)-  => a -- ^ Epsilon, a maximum tolerated error. Sign is ignored.-  -> a -- ^ Expected result.-  -> a -- ^ Tested value.+epsilonExpect+  :: (HasCallStack, Show a, RealFloat a)+  => a+  -- ^ Epsilon, a maximum tolerated error. Sign is ignored.+  -> a+  -- ^ Expected result.+  -> a+  -- ^ Tested value.   -> Expectation epsilonExpect epsilon x y =   X.forM_ (epsilonMaybeEq epsilon x y) $ \errMsg ->     expectationFailure $ "Expected: " ++ show x ++ " but got: " ++ show y ++ "\n   " ++ errMsg --epsilonFoldableExpect ::-     (HasCallStack, Foldable f, Show (f e), Show e, RealFloat e) => e -> f e -> f e -> Expectation+epsilonFoldableExpect+  :: (HasCallStack, Foldable f, Show (f e), Show e, RealFloat e) => e -> f e -> f e -> Expectation epsilonFoldableExpect epsilon x y = do   F.length x `shouldBe` F.length y   unless (F.null x) $     X.forM_ (zipWithM (epsilonMaybeEq epsilon) (F.toList x) (F.toList y)) $ \errMsgs ->       expectationFailure $-      "Expected: " ++ show x ++ " but got: " ++ show y ++ "\n" ++ unlines (fmap ("    " ++) errMsgs)-+        "Expected: " ++ show x ++ " but got: " ++ show y ++ "\n" ++ unlines (fmap ("    " ++) errMsgs) -epsilonMaybeEq ::-     (Show a, RealFloat a)-  => a -- ^ Epsilon, a maximum tolerated error. Sign is ignored.-  -> a -- ^ Expected result.-  -> a -- ^ Tested value.+epsilonMaybeEq+  :: (Show a, RealFloat a)+  => a+  -- ^ Epsilon, a maximum tolerated error. Sign is ignored.+  -> a+  -- ^ Expected result.+  -> a+  -- ^ Tested value.   -> Maybe String epsilonMaybeEq epsilon x y   | isNaN x && not (isNaN y) = Just $ "Expected NaN, but got: " ++ show y@@ -161,26 +177,32 @@     n = epsilon * (1 + max absx absy)     diff = abs (y - x) --epsilonEq ::-     (Show a, RealFloat a)-  => a -- ^ Epsilon, a maximum tolerated error. Sign is ignored.-  -> a -- ^ Expected result.-  -> a -- ^ Tested value.+epsilonEq+  :: (Show a, RealFloat a)+  => a+  -- ^ Epsilon, a maximum tolerated error. Sign is ignored.+  -> a+  -- ^ Expected result.+  -> a+  -- ^ Tested value.   -> Property epsilonEq epsilon x y = property $ epsilonExpect epsilon x y -epsilonEqDouble ::-     Double -- ^ Expected result.-  -> Double -- ^ Tested value.+epsilonEqDouble+  :: Double+  -- ^ Expected result.+  -> Double+  -- ^ Tested value.   -> Property epsilonEqDouble = epsilonEq epsilon   where     epsilon = 1e-12 -epsilonEqFloat ::-     Float -- ^ Expected result.-  -> Float -- ^ Tested value.+epsilonEqFloat+  :: Float+  -- ^ Expected result.+  -> Float+  -- ^ Tested value.   -> Property epsilonEqFloat = epsilonEq epsilon   where
tests/Test/Massiv/Array/Delayed/InterleavedSpec.hs view
@@ -1,20 +1,19 @@-{-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE TypeApplications #-}-module Test.Massiv.Array.Delayed.InterleavedSpec-  ( spec-  ) where +module Test.Massiv.Array.Delayed.InterleavedSpec (+  spec,+) where+ import Data.Massiv.Array import Test.Massiv.Core --prop_EqDelayed ::-     (Ragged L ix Int, Load D ix Int, Load DI ix Int)+prop_EqDelayed+  :: (Ragged L ix Int, Load D ix Int, Load DI ix Int)   => Array D ix Int   -> Property prop_EqDelayed arr = computeAs P arr === computeAs P (toInterleaved arr)-  prop_Resize :: (Ragged L ix Int) => Array DI ix Int -> Property prop_Resize arr =
tests/Test/Massiv/Array/Delayed/PushSpec.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}+ module Test.Massiv.Array.Delayed.PushSpec (spec) where  -- import Data.Massiv.Array.Delayed@@ -8,22 +9,20 @@ -- import Data.Massiv.Array as A import Test.Massiv.Core - -- prop_upsampleDifferentDefault :: --      Proxy ix -> Comp -> SzIx ix -> Int -> Maybe Int -> Property -- prop_upsampleDifferentDefault _ comp (SzIx sz ix) v mDef = --   computeAs P (unsafeMakeLoadArray comp sz mDef $ \ put -> put ix v) - spec :: Spec spec = pure ()-  -- describe "upsampleDifferentDefault" $ do-  --   it "Ix1" $ property $ prop_upsampleDifferentDefault (Proxy :: Proxy Ix1)-  --   it "Ix2" $ property $ prop_upsampleDifferentDefault (Proxy :: Proxy Ix2)-  --   it "Ix3" $ property $ prop_upsampleDifferentDefault (Proxy :: Proxy Ix3)-  --   it "Ix4" $ property $ prop_upsampleDifferentDefault (Proxy :: Proxy Ix4)-  --   it "Ix5" $ property $ prop_upsampleDifferentDefault (Proxy :: Proxy Ix5) +-- describe "upsampleDifferentDefault" $ do+--   it "Ix1" $ property $ prop_upsampleDifferentDefault (Proxy :: Proxy Ix1)+--   it "Ix2" $ property $ prop_upsampleDifferentDefault (Proxy :: Proxy Ix2)+--   it "Ix3" $ property $ prop_upsampleDifferentDefault (Proxy :: Proxy Ix3)+--   it "Ix4" $ property $ prop_upsampleDifferentDefault (Proxy :: Proxy Ix4)+--   it "Ix5" $ property $ prop_upsampleDifferentDefault (Proxy :: Proxy Ix5)  -- identityDL :: Int -> Array DL Ix2 Int -- identityDL n = makeLoadArrayS (Sz2 n n) 0 $ \ writeCell -> do
tests/Test/Massiv/Array/Delayed/StreamSpec.hs view
@@ -2,11 +2,11 @@  module Test.Massiv.Array.Delayed.StreamSpec (spec) where +import Data.Int import Data.Massiv.Array-import Test.Massiv.Core import Test.Massiv.Array.Delayed import Test.Massiv.Array.Load-import Data.Int+import Test.Massiv.Core  spec :: Spec spec = do
tests/Test/Massiv/Array/Delayed/WindowedSpec.hs view
@@ -5,24 +5,21 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-}+ module Test.Massiv.Array.Delayed.WindowedSpec (spec) where -import Data.Massiv.Array.Delayed-import Data.Massiv.Array.Unsafe import Data.Massiv.Array as A import Test.Massiv.Core --prop_EqDelayed ::-     (Ragged L ix Int, Load DW ix Int) => Proxy ix -> ArrDW ix Int -> Property+prop_EqDelayed+  :: (Ragged L ix Int, Load DW ix Int) => Proxy ix -> ArrDW ix Int -> Property prop_EqDelayed _ (ArrDW arrD arrDW) =   computeAs P arrD === computeAs P arrDW -prop_EqDelayedStride ::-     (Ragged L ix Int, StrideLoad DW ix Int) => Proxy ix -> Stride ix -> ArrDW ix Int -> Property+prop_EqDelayedStride+  :: (Ragged L ix Int, StrideLoad DW ix Int) => Proxy ix -> Stride ix -> ArrDW ix Int -> Property prop_EqDelayedStride _ stride (ArrDW arrD arrDW) =   computeWithStrideAs P stride arrD === computeWithStrideAs P stride arrDW-  spec :: Spec spec = do
tests/Test/Massiv/Array/DelayedSpec.hs view
@@ -1,19 +1,19 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+ module Test.Massiv.Array.DelayedSpec (spec) where -import Data.Massiv.Array.Unsafe import Data.Massiv.Array as A+import Data.Massiv.Array.Unsafe import Test.Massiv.Core - downsampleArr :: (Index ix, Source r e) => Stride ix -> Array r ix e -> Array D ix e downsampleArr stride arr =   unsafeBackpermute (strideSize stride (size arr)) (liftIndex2 (*) (unStride stride)) arr -prop_computeWithStrideEqDownsample ::-     Ragged L ix Int+prop_computeWithStrideEqDownsample+  :: Ragged L ix Int   => proxy ix   -> Stride ix   -> Array D ix Int@@ -21,9 +21,8 @@ prop_computeWithStrideEqDownsample _ stride arr =   computeWithStride stride arr === computeAs U (downsampleArr stride arr) --prop_computeWithStrideInterleavedEqDownsample ::-     Ragged L ix Int+prop_computeWithStrideInterleavedEqDownsample+  :: Ragged L ix Int   => proxy ix   -> Stride ix   -> Array D ix Int@@ -31,29 +30,28 @@ prop_computeWithStrideInterleavedEqDownsample _ stride arr =   computeWithStride stride (toInterleaved arr) === computeAs U (downsampleArr stride arr) -prop_computeWithStrideWindowedEqDownsample ::-     (Ragged L ix Int, StrideLoad DW ix Int)+prop_computeWithStrideWindowedEqDownsample+  :: (Ragged L ix Int, StrideLoad DW ix Int)   => proxy ix   -> Stride ix   -> ArrIx D ix Int   -> Property prop_computeWithStrideWindowedEqDownsample _ stride (ArrIx arr _) =-  computeWithStride stride (makeWindowedArray arr zeroIndex (size arr) (unsafeIndex arr)) ===-  computeAs U (downsampleArr stride arr)-+  computeWithStride stride (makeWindowedArray arr zeroIndex (size arr) (unsafeIndex arr))+    === computeAs U (downsampleArr stride arr) -delayedSpec ::-     (Arbitrary ix, StrideLoad DW ix Int, Ragged L ix Int)+delayedSpec+  :: (Arbitrary ix, StrideLoad DW ix Int, Ragged L ix Int)   => String   -> proxy ix   -> Spec delayedSpec dimName proxy =   describe dimName $ do-    it "computeWithStrideEqDownsample" $ property $ prop_computeWithStrideEqDownsample proxy-    it "computeWithStrideInterleavedEqDownsample" $-      property $ prop_computeWithStrideInterleavedEqDownsample proxy-    it "computeWithStrideWindowedEqDownsample" $-      property $ prop_computeWithStrideWindowedEqDownsample proxy+    prop "computeWithStrideEqDownsample" $ prop_computeWithStrideEqDownsample proxy+    prop "computeWithStrideInterleavedEqDownsample" $+      prop_computeWithStrideInterleavedEqDownsample proxy+    prop "computeWithStrideWindowedEqDownsample" $+      prop_computeWithStrideWindowedEqDownsample proxy  spec :: Spec spec = do
tests/Test/Massiv/Array/Manifest/PrimitiveSpec.hs view
@@ -1,16 +1,19 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}+ module Test.Massiv.Array.Manifest.PrimitiveSpec (spec) where  import Data.Massiv.Array as A import Data.Massiv.Array.Unsafe-import Test.Massiv.Core-import Data.Word import Data.Primitive.ByteArray+import Data.Word+import Test.Massiv.Array.MutableSpec (specUnboxedMutableR)+import Test.Massiv.Core -prop_ToFromByteArray ::-     forall ix. (Ragged L ix Word16)+prop_ToFromByteArray+  :: forall ix+   . (Ragged L ix Word16)   => Array P ix Word16   -> Property prop_ToFromByteArray arr =@@ -32,9 +35,9 @@     marr'' <- fromMutableByteArrayOffsetM sz mba' (unwrapMutableByteArray marr)     unsafeFreeze Seq marr'' `shouldReturn` arr --prop_ToFromPrimitiveVector ::-     forall ix. (Ragged L ix Word)+prop_ToFromPrimitiveVector+  :: forall ix+   . (Ragged L ix Word)   => Array P ix Word   -> Property prop_ToFromPrimitiveVector arr =@@ -56,3 +59,4 @@       prop "ToFromPrimitiveVector" $ prop_ToFromPrimitiveVector @Ix1       prop "ToFromPrimitiveVector" $ prop_ToFromPrimitiveVector @Ix2       prop "ToFromPrimitiveVector" $ prop_ToFromPrimitiveVector @Ix3+    specUnboxedMutableR @P @Word16
+ tests/Test/Massiv/Array/Manifest/UnboxedSpec.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE TypeApplications #-}++module Test.Massiv.Array.Manifest.UnboxedSpec (spec) where++import Data.Massiv.Array as A+import Data.Word+import Test.Massiv.Array.MutableSpec (specUnboxedMutableR)+import Test.Massiv.Core++spec :: Spec+spec =+  describe "Unboxed" $ do+    specUnboxedMutableR @U @Word16+    specUnboxedMutableR @S @Word32
tests/Test/Massiv/Array/Manifest/VectorSpec.hs view
@@ -3,16 +3,17 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}+ module Test.Massiv.Array.Manifest.VectorSpec (spec) where -import Data.Massiv.Array.Manifest.Vector import Data.Massiv.Array as A-import Test.Massiv.Core+import Data.Massiv.Array.Manifest.Vector import qualified Data.Vector as VB import qualified Data.Vector.Generic as VG import qualified Data.Vector.Primitive as VP import qualified Data.Vector.Storable as VS import qualified Data.Vector.Unboxed as VU+import Test.Massiv.Core  prop_castToFromVector   :: ( VG.Vector (VRepr r) Int@@ -23,14 +24,16 @@      , Show (Array r ix Int)      , Index ix      )-  => proxy ix -> r -> ArrNE r ix Int -> Property+  => proxy ix+  -> r+  -> ArrNE r ix Int+  -> Property prop_castToFromVector _ _ (ArrNE arr) =   Just arr === (castToVector arr >>= castFromVector (getComp arr) (size arr)) --prop_toFromVector ::-     forall r ix v.-     ( Manifest r Int+prop_toFromVector+  :: forall r ix v+   . ( Manifest r Int      , Manifest (ARepr v) Int      , VRepr (ARepr v) ~ v      , Eq (Array r ix Int)@@ -48,8 +51,7 @@ prop_toFromVector _ _ _ (ArrNE arr) =   let comp = getComp arr       arr' = fromVector' comp (size arr) (toVector arr :: v Int)-  in arr' === arr .&&. (getComp arr' === comp)-+   in arr' === arr .&&. (getComp arr' === comp)  toFromVectorSpec :: Spec toFromVectorSpec = do@@ -76,7 +78,6 @@         describe "Through Storable Vector" $ do           it "Ix1" $ property $ prop_toFromVector (Proxy :: Proxy VS.Vector) (Proxy :: Proxy Ix1) r           it "Ix2" $ property $ prop_toFromVector (Proxy :: Proxy VS.Vector) (Proxy :: Proxy Ix2) r-  spec :: Spec spec = describe "toFromVector" toFromVectorSpec
tests/Test/Massiv/Array/ManifestSpec.hs view
@@ -3,32 +3,33 @@ {-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeApplications #-}+ module Test.Massiv.Array.ManifestSpec (spec) where  import Data.ByteString as S import Data.ByteString.Builder as S import Data.ByteString.Lazy as SL import Data.Massiv.Array as A-import Test.Massiv.Core import Data.Word (Word8)-+import Test.Massiv.Core  -- ByteString-prop_toFromByteString ::-     (Show (Vector r Word8), Eq (Vector r Word8), Load r Ix1 Word8) => Vector r Word8 -> Property+prop_toFromByteString+  :: (Show (Vector r Word8), Eq (Vector r Word8), Load r Ix1 Word8) => Vector r Word8 -> Property prop_toFromByteString arr = arr === fromByteString (getComp arr) (toByteString arr)  prop_castToFromByteString :: Vector S Word8 -> Property prop_castToFromByteString arr = arr === castFromByteString (getComp arr) (castToByteString arr) - prop_fromToByteString :: Comp -> [Word8] -> Property prop_fromToByteString comp ls = bs === toByteString (fromByteString comp bs :: Vector P Word8)-  where bs = S.pack ls+  where+    bs = S.pack ls  prop_toBuilder :: Array P Ix1 Word8 -> Property prop_toBuilder arr = bs === SL.toStrict (S.toLazyByteString (toBuilder S.word8 arr))-  where bs = toByteString arr+  where+    bs = toByteString arr  conversionSpec :: Spec conversionSpec =@@ -38,7 +39,6 @@     it "to/from ByteString S" $ property (prop_toFromByteString @S)     it "from/to ByteString" $ property prop_fromToByteString     it "toBuilder" $ property prop_toBuilder-  spec :: Spec spec = describe "Conversion" conversionSpec
tests/Test/Massiv/Array/MutableSpec.hs view
@@ -1,53 +1,56 @@-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}-module Test.Massiv.Array.MutableSpec (spec) where +module Test.Massiv.Array.MutableSpec where++import Data.Int import Data.Massiv.Array as A-import Test.Massiv.Core-import Test.Massiv.Core.Mutable+import GHC.Exts import Test.Massiv.Array.Delayed-import Test.Massiv.Array.Mutable import Test.Massiv.Array.Load-import GHC.Exts-import Data.Int+import Test.Massiv.Array.Mutable+import Test.Massiv.Core+import Test.Massiv.Core.Mutable -type MutableArraySpec r ix e-   = ( Show e-     , Eq e-     , Arbitrary e-     , Arbitrary ix-     , CoArbitrary e-     , Function e-     , Eq (Array r ix e)-     , Show (Array r ix e)-     , Eq (Vector r e)-     , Show (Vector r e)-     , Load r ix e-     , Arbitrary (Array r ix e)-     , Manifest r e-     , Stream r ix e-     )+type MutableArraySpec r ix e =+  ( Show e+  , Eq e+  , Arbitrary e+  , Arbitrary ix+  , CoArbitrary e+  , Function e+  , Eq (Array r ix e)+  , Show (Array r ix e)+  , Eq (Vector r e)+  , Show (Vector r e)+  , Load r ix e+  , Arbitrary (Array r ix e)+  , Manifest r e+  , Stream r ix e+  ) -type MutableSpec r e-   = ( Typeable e-     , IsList (Array r Ix1 e)-     , Item (Array r Ix1 e) ~ e-     , MutableArraySpec r Ix1 e-     , MutableArraySpec r Ix2 e-     , MutableArraySpec r Ix3 e-     , MutableArraySpec r Ix4 e-     , MutableArraySpec r Ix5 e)+type MutableSpec r e =+  ( Typeable e+  , IsList (Array r Ix1 e)+  , Item (Array r Ix1 e) ~ e+  , MutableArraySpec r Ix1 e+  , MutableArraySpec r Ix2 e+  , MutableArraySpec r Ix3 e+  , MutableArraySpec r Ix4 e+  , MutableArraySpec r Ix5 e+  )  localMutableSpec :: forall r ix e. (MutableArraySpec r ix e) => Spec localMutableSpec = do   describe "toStream/toList" $-    it "toStream" $ property (prop_toStream @r @ix @e)+    it "toStream" $+      property (prop_toStream @r @ix @e)   describe "Manifest operations" $ do     it "write" $ property (prop_Write @r @ix @e)     it "modify" $ property (prop_Modify @r @ix @e)@@ -64,11 +67,11 @@   mutableSpec @r @Ix2 @e   mutableSpec @r @Ix3 @e   mutableSpec @r @Ix4 @e+  -- mutableSpec @r @Ix5 @e -- slows down the test suite   loadSpec @r @Ix1 @e   loadSpec @r @Ix2 @e   loadSpec @r @Ix3 @e   loadSpec @r @Ix4 @e-  --mutableSpec @r @Ix5 @e -- slows down the test suite   localMutableSpec @r @Ix1 @e   localMutableSpec @r @Ix2 @e   localMutableSpec @r @Ix3 @e@@ -80,11 +83,12 @@     specMutableNonFlatR @r @Ix4 @e     specMutableNonFlatR @r @Ix5 @e   describe "toStream/toList" $-    it "toStreamIsList" $ property (prop_toStreamIsList @r @e)+    it "toStreamIsList" $+      property (prop_toStreamIsList @r @e) -specMutableNonFlatR ::-     forall r ix e.-     ( Arbitrary ix+specMutableNonFlatR+  :: forall r ix e+   . ( Arbitrary ix      , Typeable e      , Arbitrary e      , Index (Lower ix)@@ -97,8 +101,8 @@   => Spec specMutableNonFlatR = do   describe (showsArrayType @r @ix @e "") $-    prop "outerSliceMArrayM" $ prop_outerSliceMArrayM @r @ix @e-+    prop "outerSliceMArrayM" $+      prop_outerSliceMArrayM @r @ix @e  specUnboxedMutableR :: forall r e. MutableSpec r e => Spec specUnboxedMutableR = do@@ -109,123 +113,128 @@   unsafeMutableUnboxedSpec @r @Ix4 @e   unsafeMutableUnboxedSpec @r @Ix5 @e -prop_Write ::-     forall r ix e. (Index ix, Manifest r e, Eq e, Show e)+prop_Write+  :: forall r ix e+   . (Index ix, Manifest r e, Eq e, Show e)   => Array r ix e   -> ix   -> e   -> Property prop_Write arr ix e =   monadicIO $-  run $ do-    marr <- thaw arr-    A.read marr ix >>= \case-      Nothing ->-        let withExcept = assertExceptionIO (== IndexOutOfBoundsException (size arr) ix)-         in pure-              (withExcept (writeM marr ix e) .&&.-               (write marr ix e `shouldReturn` False) .&&.-               (write_ marr ix e `shouldReturn` ()))-      Just olde ->-        pure $-        property $ do-          indexM arr ix `shouldReturn` olde-          A.write marr ix e `shouldReturn` True-          A.read marr ix `shouldReturn` Just e--          marr' <- thaw arr-          writeM marr' ix e `shouldReturn` ()-          arr' <- freeze (getComp arr) marr'-          indexM arr' ix `shouldReturn` e+    run $ do+      marr <- thaw arr+      A.read marr ix >>= \case+        Nothing ->+          let withExcept = assertDeepExceptionIO (== IndexOutOfBoundsException (size arr) ix)+           in pure+                ( withExcept (writeM marr ix e)+                    .&&. (write marr ix e `shouldReturn` False)+                    .&&. (write_ marr ix e `shouldReturn` ())+                )+        Just olde ->+          pure $+            property $ do+              indexM arr ix `shouldReturn` olde+              A.write marr ix e `shouldReturn` True+              A.read marr ix `shouldReturn` Just e -          arr'' <- withMArray_ arr (\_ ma -> write_ ma ix e)-          index' arr'' ix `shouldBe` e+              marr' <- thaw arr+              writeM marr' ix e `shouldReturn` ()+              arr' <- freeze (getComp arr) marr'+              indexM arr' ix `shouldReturn` e +              arr'' <- withMArray_ arr (\_ ma -> write_ ma ix e)+              index' arr'' ix `shouldBe` e -prop_Modify ::-     forall r ix e. (Index ix, Manifest r e, Eq e, Show e)+prop_Modify+  :: forall r ix e+   . (Index ix, Manifest r e, Eq e, Show e)   => Array r ix e   -> Fun e e   -> ix   -> Property prop_Modify arr f ix =   monadicIO $-  run $ do-    marr <- thaw arr-    modify marr (pure . apply f) ix >>= \case-      Nothing ->-        let withExcept = assertExceptionIO (== IndexOutOfBoundsException (size arr) ix)-         in pure-              (withExcept (void $ indexM arr ix) .&&.-               withExcept (void $ readM marr ix) .&&.-               withExcept (void $ modifyM marr (pure . apply f) ix) .&&.-               withExcept (modifyM_ marr (pure . apply f) ix) .&&.-               (modify_ marr (pure . apply f) ix `shouldReturn` ()))-      Just e ->-        pure $-        property $ do-          let fM = pure . apply f-              fe = apply f e-          indexM arr ix `shouldReturn` e-          A.read marr ix `shouldReturn` Just fe+    run $ do+      marr <- thaw arr+      modify marr (pure . apply f) ix >>= \case+        Nothing ->+          let withExcept = assertDeepExceptionIO (== IndexOutOfBoundsException (size arr) ix)+           in pure+                ( withExcept (void $ indexM arr ix)+                    .&&. withExcept (void $ readM marr ix)+                    .&&. withExcept (void $ modifyM marr (pure . apply f) ix)+                    .&&. withExcept (modifyM_ marr (pure . apply f) ix)+                    .&&. (modify_ marr (pure . apply f) ix `shouldReturn` ())+                )+        Just e ->+          pure $+            property $ do+              let fM = pure . apply f+                  fe = apply f e+              indexM arr ix `shouldReturn` e+              A.read marr ix `shouldReturn` Just fe -          marr' <- thawS arr-          readM marr' ix `shouldReturn` e-          modifyM marr' fM ix `shouldReturn` e-          arr' <- freezeS marr'-          indexM arr' ix `shouldReturn` fe+              marr' <- thawS arr+              readM marr' ix `shouldReturn` e+              modifyM marr' fM ix `shouldReturn` e+              arr' <- freezeS marr'+              indexM arr' ix `shouldReturn` fe -          arr'' <- withMArrayS_ arr (\ma -> modify_ ma fM ix)-          index' arr'' ix `shouldBe` fe+              arr'' <- withMArrayS_ arr (\ma -> modify_ ma fM ix)+              index' arr'' ix `shouldBe` fe -prop_Swap ::-     forall r ix e. (Index ix, Manifest r e, Eq e, Show e)+prop_Swap+  :: forall r ix e+   . (Index ix, Manifest r e, Eq e, Show e)   => Array r ix e   -> ix   -> ix   -> Property prop_Swap arr ix1 ix2 =   monadicIO $-  run $ do-    marr <- thaw arr-    swap marr ix1 ix2 >>= \case-      Nothing ->-        let withExcept =-              assertExceptionIO-                (\case-                   IndexOutOfBoundsException _ _ -> True-                   _ -> False)-         in pure-              (withExcept (void $ indexM arr ix1 >> indexM arr ix2) .&&.-               withExcept (void $ readM marr ix1 >> readM marr ix2) .&&.-               withExcept (void $ swapM marr ix1 ix2) .&&.-               withExcept (void $ swapM marr ix2 ix1) .&&.-               withExcept (swapM_ marr ix1 ix2) .&&.-               withExcept (swapM_ marr ix2 ix1) .&&.-               (swap_ marr ix1 ix2 `shouldReturn` ()) .&&.-               (swap_ marr ix2 ix1 `shouldReturn` ()))-      Just (e1, e2) ->-        pure $-        property $ do-          indexM arr ix1 `shouldReturn` e1-          indexM arr ix2 `shouldReturn` e2-          readM marr ix1 `shouldReturn` e2-          readM marr ix2 `shouldReturn` e1--          marr' <- thawS arr-          swapM marr' ix1 ix2 `shouldReturn` (e1, e2)-          arr' <- freezeS marr'-          indexM arr' ix1 `shouldReturn` e2-          indexM arr' ix2 `shouldReturn` e1+    run $ do+      marr <- thaw arr+      swap marr ix1 ix2 >>= \case+        Nothing ->+          let withExcept =+                assertDeepExceptionIO+                  ( \case+                      IndexOutOfBoundsException _ _ -> True+                      _ -> False+                  )+           in pure+                ( withExcept (void $ indexM arr ix1 >> indexM arr ix2)+                    .&&. withExcept (void $ readM marr ix1 >> readM marr ix2)+                    .&&. withExcept (void $ swapM marr ix1 ix2)+                    .&&. withExcept (void $ swapM marr ix2 ix1)+                    .&&. withExcept (swapM_ marr ix1 ix2)+                    .&&. withExcept (swapM_ marr ix2 ix1)+                    .&&. (swap_ marr ix1 ix2 `shouldReturn` ())+                    .&&. (swap_ marr ix2 ix1 `shouldReturn` ())+                )+        Just (e1, e2) ->+          pure $+            property $ do+              indexM arr ix1 `shouldReturn` e1+              indexM arr ix2 `shouldReturn` e2+              readM marr ix1 `shouldReturn` e2+              readM marr ix2 `shouldReturn` e1 -          let arr'' = withMArrayST_ arr (\ma -> swap_ ma ix1 ix2)-          index' arr'' ix1 `shouldBe` e2-          index' arr'' ix2 `shouldBe` e1+              marr' <- thawS arr+              swapM marr' ix1 ix2 `shouldReturn` (e1, e2)+              arr' <- freezeS marr'+              indexM arr' ix1 `shouldReturn` e2+              indexM arr' ix2 `shouldReturn` e1 +              let arr'' = withMArrayST_ arr (\ma -> swap_ ma ix1 ix2)+              index' arr'' ix1 `shouldBe` e2+              index' arr'' ix2 `shouldBe` e1 -prop_outerSliceMArrayM ::-     forall r ix e.-     ( Index ix+prop_outerSliceMArrayM+  :: forall r ix e+   . ( Index ix      , Index (Lower ix)      , Manifest r e      , Eq (Array r (Lower ix) e)@@ -247,15 +256,11 @@       iOut <- oneof [chooseInt (minBound, -1), chooseInt (n, maxBound)]       pure (iIn, iOut) - spec :: Spec spec = do   specMutableR @B @Int16   specMutableR @BN @Int16   specMutableR @BL @Int16-  specUnboxedMutableR @S @Int16-  specUnboxedMutableR @P @Int16-  specUnboxedMutableR @U @Int16   atomicIntSpec @Ix1   atomicIntSpec @Ix2   atomicIntSpec @Ix3
tests/Test/Massiv/Array/Numeric/IntegralSpec.hs view
@@ -1,6 +1,6 @@-module Test.Massiv.Array.Numeric.IntegralSpec-  ( spec-  ) where+module Test.Massiv.Array.Numeric.IntegralSpec (+  spec,+) where  import Data.Massiv.Array as A import Data.Massiv.Array.Numeric.Integral
tests/Test/Massiv/Array/NumericSpec.hs view
@@ -1,8 +1,8 @@ {-# LANGUAGE TypeApplications #-} -module Test.Massiv.Array.NumericSpec-  ( spec-  ) where+module Test.Massiv.Array.NumericSpec (+  spec,+) where  import Data.Massiv.Array as A import Test.Massiv.Array.Numeric
tests/Test/Massiv/Array/Ops/ConstructSpec.hs view
@@ -2,12 +2,13 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-}+ module Test.Massiv.Array.Ops.ConstructSpec (spec) where  import Data.List as L import Data.Massiv.Array as A+import qualified GHC.Exts as GHC (IsList (..)) import Test.Massiv.Core-import qualified GHC.Exts as GHC (IsList(..)) import Prelude as P  prop_rangeEqRangeStep1 :: Int -> Int -> Property@@ -20,23 +21,22 @@ prop_rangeStepEqEnumFromStepN from (NonZero step) sz =   rangeStep' Seq from step (from + step * sz) === enumFromStepN Par from step (Sz sz) - prop_rangeStepExc :: Int -> Int -> Property prop_rangeStepExc from to =-  assertException+  assertDeepException     selectErrorCall     (computeAs U (rangeStep' Seq from 0 to)) -prop_toFromListIsList ::-     (Show (Array U ix Int), GHC.IsList (Array U ix Int), Index ix)+prop_toFromListIsList+  :: (Show (Array U ix Int), GHC.IsList (Array U ix Int), Index ix)   => Proxy ix   -> Array U ix Int   -> Property prop_toFromListIsList _ arr = arr === GHC.fromList (GHC.toList arr) --prop_toFromList ::-  forall ix . (Show (Array B ix Int), Ragged L ix Int)+prop_toFromList+  :: forall ix+   . (Show (Array B ix Int), Ragged L ix Int)   => Proxy ix   -> Array B ix Int   -> Property@@ -46,23 +46,21 @@     arr' = fromLists' comp $ toLists arr     comp' = getComp arr' - prop_excFromToListIx2 :: Comp -> [[Int]] -> Property prop_excFromToListIx2 comp ls2 =   if P.null lsL || P.all (head lsL ==) lsL-     then label "Expected Success" $ resultLs === ls2-     else label "Expected Failure" $ assertSomeException resultLs+    then label "Expected Success" $ resultLs === ls2+    else label "Expected Failure" $ assertSomeException resultLs   where     lsL = P.map P.length ls2     resultLs = toLists (fromLists' comp ls2 :: Array U Ix2 Int) - prop_excFromToListIx3 :: Comp -> [[[Int]]] -> Property prop_excFromToListIx3 comp ls3   | P.null (P.concat (P.concat ls3)) =-    classify True "Expected Success" $ counterexample (show arr) $ totalElem (size arr) === 0+      classify True "Expected Success" $ counterexample (show arr) $ totalElem (size arr) === 0   | P.all (head lsL ==) lsL && P.all (P.all (head (head lsLL) ==)) lsLL =-    classify True "Expected Success" $ counterexample (show arr) $ resultLs === ls3+      classify True "Expected Success" $ counterexample (show arr) $ resultLs === ls3   | otherwise = classify True "Expected Failure" $ assertSomeException resultLs   where     arr = fromLists' comp ls3 :: Array U Ix3 Int@@ -70,7 +68,6 @@     lsL = P.map P.length ls3     lsLL = P.map (P.map P.length) ls3 - specConstructIx1 :: Spec specConstructIx1 = do   prop "toFromList" $ prop_toFromList (Proxy :: Proxy Ix1)@@ -99,26 +96,30 @@ initArr = makeArray Seq (Sz1 3) mkIntermediate  initArr2 :: Array BN Ix2 (Array U Ix1 Int)-initArr2 = makeArray Seq (Sz 2) (\ (x :. y) -> mkIntermediate (x+y))+initArr2 = makeArray Seq (Sz 2) (\(x :. y) -> mkIntermediate (x + y))  prop_unfoldrList :: Sz1 -> Fun Word (Int, Word) -> Word -> Property prop_unfoldrList sz1 f i =   conjoin $-  L.zipWith-    (===)-    (A.toList (computeAs P $ unfoldrS_ sz1 (apply f) i))-    (L.unfoldr (Just . apply f) i)+    L.zipWith+      (===)+      (A.toList (computeAs P $ unfoldrS_ sz1 (apply f) i))+      (L.unfoldr (Just . apply f) i)  specExpand :: Spec specExpand = do-  it "expandOuter" $ compute (expandOuter 2 A.index' initArr :: Array D Ix2 Int) `shouldBe`-    resize' (Sz2 2 3) (fromList Seq [50, 51, 52, 75, 76, 77] :: Array U Ix1 Int)-  it "expandInner" $ compute (expandInner 2 A.index' initArr :: Array D Ix2 Int) `shouldBe`-    resize' (Sz2 3 2) (fromList Seq [50, 75, 51, 76, 52, 77] :: Array U Ix1 Int)-  it "expandwithin" $ compute (expandWithin Dim1 2 A.index' initArr2 :: Array D Ix3 Int) `shouldBe`-    resize' (Sz 2) (fromList Seq [50, 75, 51, 76, 51, 76, 52, 77] :: Array U Ix1 Int)-  it "expandwithin'" $ compute (expandWithin' 1 2 A.index' initArr2 :: Array D Ix3 Int) `shouldBe`-    resize' (Sz 2) (fromList Seq [50, 75, 51, 76, 51, 76, 52, 77] :: Array U Ix1 Int)+  it "expandOuter" $+    compute (expandOuter 2 A.index' initArr :: Array D Ix2 Int)+      `shouldBe` resize' (Sz2 2 3) (fromList Seq [50, 51, 52, 75, 76, 77] :: Array U Ix1 Int)+  it "expandInner" $+    compute (expandInner 2 A.index' initArr :: Array D Ix2 Int)+      `shouldBe` resize' (Sz2 3 2) (fromList Seq [50, 75, 51, 76, 52, 77] :: Array U Ix1 Int)+  it "expandwithin" $+    compute (expandWithin Dim1 2 A.index' initArr2 :: Array D Ix3 Int)+      `shouldBe` resize' (Sz 2) (fromList Seq [50, 75, 51, 76, 51, 76, 52, 77] :: Array U Ix1 Int)+  it "expandwithin'" $+    compute (expandWithin' 1 2 A.index' initArr2 :: Array D Ix3 Int)+      `shouldBe` resize' (Sz 2) (fromList Seq [50, 75, 51, 76, 51, 76, 52, 77] :: Array U Ix1 Int)  spec :: Spec spec = do
tests/Test/Massiv/Array/Ops/FoldSpec.hs view
@@ -5,31 +5,28 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}+ module Test.Massiv.Array.Ops.FoldSpec (spec) where  import qualified Data.Foldable as F import Data.Massiv.Array as A import Data.Semigroup-import Prelude hiding (map, product, sum) import Test.Massiv.Core--+import Prelude hiding (map, product, sum)  prop_SumSEqSumP :: Index ix => Array D ix Int -> Bool prop_SumSEqSumP arr = sum arr == sum (setComp Par arr) - prop_ProdSEqProdP :: Index ix => Array D ix Int -> Bool prop_ProdSEqProdP arr = product arr == product (setComp Par arr) - foldOpsProp :: Index ix => Fun Int Bool -> ArrTinyNE P ix Int -> Expectation foldOpsProp f (ArrTinyNE arr) = do   A.maximum' arr `shouldBe` getMax (foldMono Max arr)   A.minimum' arr `shouldBe` getMin (foldSemi Min maxBound arr)   A.sum arr `shouldBe` F.sum ls-  A.product (A.map ((+ 0.1) . (fromIntegral :: Int -> Double)) arr) `shouldBe`-    getProduct (foldMono (Product . (+ 0.1) . fromIntegral) arr)+  A.product (A.map ((+ 0.1) . (fromIntegral :: Int -> Double)) arr)+    `shouldBe` getProduct (foldMono (Product . (+ 0.1) . fromIntegral) arr)   A.all (apply f) arr `shouldBe` F.all (apply f) ls   A.and (A.map (apply f) arr) `shouldBe` F.and (fmap (apply f) ls)   A.any (apply f) arr `shouldBe` F.any (apply f) ls@@ -37,13 +34,12 @@   where     ls = toList arr - prop_NestedFoldP :: Array D Ix1 (Array D Ix1 Int) -> Bool prop_NestedFoldP arr = sum (setComp Par (map sum $ setComp Par arr)) == sum (map sum arr) --specFold ::-     forall ix. (Arbitrary ix, Index ix, Show (Array D ix Int), Show (Array P ix Int))+specFold+  :: forall ix+   . (Arbitrary ix, Index ix, Show (Array D ix Int), Show (Array P ix Int))   => String   -> Spec specFold dimStr =@@ -52,12 +48,10 @@     prop "prodS Eq prodP" $ prop_ProdSEqProdP @ix     prop "foldOps" $ foldOpsProp @ix - prop_foldOuterSliceToList :: (Index ix, Index (Lower ix)) => ArrTiny P ix Int -> Property prop_foldOuterSliceToList (ArrTiny arr) =   foldOuterSlice A.toList arr === A.fold (A.map pure arr) - spec :: Spec spec = do   specFold @Ix1 "Ix1"@@ -69,7 +63,7 @@     prop "Ix3" $ prop_foldOuterSliceToList @Ix3     prop "Ix4" $ prop_foldOuterSliceToList @Ix4   describe "Exceptions" $ do-    let emptySelector :: forall ix . Index ix => SizeException -> Bool+    let emptySelector :: forall ix. Index ix => SizeException -> Bool         emptySelector = (== SizeEmptyException (Sz (zeroIndex :: ix)))     it "maximumM" $ maximumM (A.empty :: Array D Ix1 Int) `shouldThrow` emptySelector @Ix1     it "minimumM" $ minimumM (A.empty :: Array D Ix2 Int) `shouldThrow` emptySelector @Ix2
tests/Test/Massiv/Array/Ops/MapSpec.hs view
@@ -3,49 +3,51 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}+ module Test.Massiv.Array.Ops.MapSpec (spec) where  import Control.Monad.ST+import Control.Scheduler import Data.Foldable as F-import Data.Massiv.Array.Unsafe import Data.Massiv.Array as A+import Data.Massiv.Array.Unsafe import Test.Massiv.Core import Prelude as P-import Control.Scheduler -prop_zipUnzip ::-     (Index ix, Show (Array D ix Int))+prop_zipUnzip+  :: (Index ix, Show (Array D ix Int))   => Array D ix Int   -> Array D ix Int   -> Property prop_zipUnzip arr1 arr2 =   (extract' zeroIndex sz arr1, extract' zeroIndex sz arr2) === A.unzip (A.zip arr1 arr2)-  where sz = Sz (liftIndex2 min (unSz (size arr1)) (unSz (size arr2)))+  where+    sz = Sz (liftIndex2 min (unSz (size arr1)) (unSz (size arr2))) -prop_zipFlip ::-     (Index ix, Show (Array D ix (Int, Int)))+prop_zipFlip+  :: (Index ix, Show (Array D ix (Int, Int)))   => Array D ix Int   -> Array D ix Int   -> Property prop_zipFlip arr1 arr2 =-  A.zip arr1 arr2 ===-  A.map (\(e2, e1) -> (e1, e2)) (A.zip arr2 arr1)+  A.zip arr1 arr2+    === A.map (\(e2, e1) -> (e1, e2)) (A.zip arr2 arr1) -prop_zipUnzip3 ::-     (Index ix, Show (Array D ix Int))+prop_zipUnzip3+  :: (Index ix, Show (Array D ix Int))   => Array D ix Int   -> Array D ix Int   -> Array D ix Int   -> Property prop_zipUnzip3 arr1 arr2 arr3 =-  (extract' zeroIndex sz arr1, extract' zeroIndex sz arr2, extract' zeroIndex sz arr3) ===-  A.unzip3 (A.zip3 arr1 arr2 arr3)+  (extract' zeroIndex sz arr1, extract' zeroIndex sz arr2, extract' zeroIndex sz arr3)+    === A.unzip3 (A.zip3 arr1 arr2 arr3)   where     sz =       Sz (liftIndex2 min (liftIndex2 min (unSz (size arr1)) (unSz (size arr2))) (unSz (size arr3))) -prop_zipFlip3 ::-     (Index ix, Show (Array D ix (Int, Int, Int)))+prop_zipFlip3+  :: (Index ix, Show (Array D ix (Int, Int, Int)))   => Array D ix Int   -> Array D ix Int   -> Array D ix Int@@ -53,8 +55,8 @@ prop_zipFlip3 arr1 arr2 arr3 =   A.zip3 arr1 arr2 arr3 === A.map (\(e3, e2, e1) -> (e1, e2, e3)) (A.zip3 arr3 arr2 arr1) -prop_zipUnzip4 ::-     (Index ix, Show (Array D ix Int))+prop_zipUnzip4+  :: (Index ix, Show (Array D ix Int))   => Array D ix Int   -> Array D ix Int   -> Array D ix Int@@ -64,25 +66,25 @@   ( extract' zeroIndex sz arr1   , extract' zeroIndex sz arr2   , extract' zeroIndex sz arr3-  , extract' zeroIndex sz arr4) ===-  A.unzip4 (A.zip4 arr1 arr2 arr3 arr4)+  , extract' zeroIndex sz arr4+  )+    === A.unzip4 (A.zip4 arr1 arr2 arr3 arr4)   where     sz = sfoldl (liftSz2 min) (size arr1) $ smap size $ sfromList [arr2, arr3, arr4] -prop_zipFlip4 ::-     (Index ix, Show (Array D ix (Int, Int, Int, Int)))+prop_zipFlip4+  :: (Index ix, Show (Array D ix (Int, Int, Int, Int)))   => Array D ix Int   -> Array D ix Int   -> Array D ix Int   -> Array D ix Int   -> Property prop_zipFlip4 arr1 arr2 arr3 arr4 =-  A.zip4 arr1 arr2 arr3 arr4 ===-  A.map (\(e4, e3, e2, e1) -> (e1, e2, e3, e4)) (A.zip4 arr4 arr3 arr2 arr1)-+  A.zip4 arr1 arr2 arr3 arr4+    === A.map (\(e4, e3, e2, e1) -> (e1, e2, e3, e4)) (A.zip4 arr4 arr3 arr2 arr1) -prop_zip4 ::-     (Index ix, Show (Array D ix (Int, Int, Int, Int)))+prop_zip4+  :: (Index ix, Show (Array D ix (Int, Int, Int, Int)))   => Array D ix Int   -> Array D ix Int   -> Array D ix Int@@ -90,21 +92,18 @@   -> Property prop_zip4 arr1 arr2 arr3 arr4 =   let f = (,,,)-   in A.zip4 arr1 arr2 arr3 arr4 ===-      A.zipWith (\(e1, e2) (e3, e4) -> f e1 e2 e3 e4) (A.zip arr1 arr2) (A.zip arr3 arr4)--+   in A.zip4 arr1 arr2 arr3 arr4+        === A.zipWith (\(e1, e2) (e3, e4) -> f e1 e2 e3 e4) (A.zip arr1 arr2) (A.zip arr3 arr4) -prop_itraverseA ::-     (Index ix, Show (Array U ix Int)) => Array D ix Int -> Fun (ix, Int) Int -> Property+prop_itraverseA+  :: (Index ix, Show (Array U ix Int)) => Array D ix Int -> Fun (ix, Int) Int -> Property prop_itraverseA arr fun =-  alt_imapM (\ix -> Just . applyFun2Compat fun ix) arr ===-  itraverseA @U (\ix -> Just . applyFun2Compat fun ix) arr-+  alt_imapM (\ix -> Just . applyFun2Compat fun ix) arr+    === itraverseA @U (\ix -> Just . applyFun2Compat fun ix) arr -mapSpec ::-     forall ix.-     ( Arbitrary ix+mapSpec+  :: forall ix+   . ( Arbitrary ix      , CoArbitrary ix      , Index ix      , Function ix@@ -124,9 +123,9 @@     it "zipUnzip4" $ property $ prop_zipUnzip4 @ix     it "zipFlip4" $ property $ prop_zipFlip4 @ix     it "zip" $ property $ prop_zip4 @ix-  describe "Traversing" $+  describe "Traversing" $ do     it "itraverseA" $ property $ prop_itraverseA @ix-  describe "StatefulMapping" $+  describe "StatefulMapping" $ do     it "mapWS" $ property $ prop_MapWS @ix  spec :: Spec@@ -136,11 +135,11 @@   describe "Ix3" $ mapSpec @Ix3   describe "Ix4" $ mapSpec @Ix4 -- alt_imapM-  :: (Applicative f, Index ix, Manifest r2 b, Source r1 a) =>-     (ix -> a -> f b) -> Array r1 ix a -> f (Array r2 ix b)+  :: (Applicative f, Index ix, Manifest r2 b, Source r1 a)+  => (ix -> a -> f b)+  -> Array r1 ix a+  -> f (Array r2 ix b) alt_imapM f arr = fmap loadList $ P.traverse (uncurry f) $ foldrS (:) [] (imap (,) arr)   where     loadList xs =@@ -150,18 +149,17 @@         unsafeFreeze (getComp arr) marr     {-# INLINE loadList #-} - prop_MapWS :: (Show (Array U ix Int), Index ix) => Array U ix Int -> Property prop_MapWS arr =   monadicIO $-  run $ do-    let comp = getComp arr-    count <- getCompWorkers comp-    arrStates <- newMArray' @P (Sz count)-    states <- initWorkerStates comp (\(WorkerId i) -> pure $ \f -> modifyM_ arrStates f i)-    arr' <--      forWS states arr $ \e smod -> do-        smod $ \acc -> pure (acc + e)-        pure e-    accsArr <- freeze Seq arrStates-    pure (A.sum arr' === A.sum accsArr .&&. arr === arr')+    run $ do+      let comp = getComp arr+      count <- getCompWorkers comp+      arrStates <- newMArray' @P (Sz count)+      states <- initWorkerStates comp (\(WorkerId i) -> pure $ \f -> modifyM_ arrStates f i)+      arr' <-+        forWS states arr $ \e smod -> do+          smod $ \acc -> pure (acc + e)+          pure e+      accsArr <- freeze Seq arrStates+      pure (A.sum arr' === A.sum accsArr .&&. arr === arr')
tests/Test/Massiv/Array/Ops/SliceSpec.hs view
@@ -3,6 +3,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}+ module Test.Massiv.Array.Ops.SliceSpec (spec) where  import Control.Applicative ((<|>))@@ -13,8 +14,8 @@ -- Size -- ----------- -prop_ExtractEqualsExtractFromTo ::-     (Source r e, Eq e, Show e, Ragged L ix e)+prop_ExtractEqualsExtractFromTo+  :: (Source r e, Eq e, Show e, Ragged L ix e)   => proxy (r, ix, e)   -> SzIx ix   -> Array r ix e@@ -22,9 +23,8 @@ prop_ExtractEqualsExtractFromTo _ (SzIx (Sz eIx) sIx) arr =   (extractFromToM sIx eIx arr <|> Nothing) === extractM sIx (Sz (liftIndex2 (-) eIx sIx)) arr --specSizeN ::-     ( HasCallStack+specSizeN+  :: ( HasCallStack      , Eq e      , Show e      , Ragged L ix e@@ -37,16 +37,16 @@   -> Spec specSizeN proxy =   describe "extract" $-    it "ExtractEqualsExtractFromTo" $ property $ prop_ExtractEqualsExtractFromTo proxy-+    it "ExtractEqualsExtractFromTo" $+      property $+        prop_ExtractEqualsExtractFromTo proxy  ----------- -- Slice -- ----------- --prop_SliceOuter ::-     ( HasCallStack+prop_SliceOuter+  :: ( HasCallStack      , Source r e      , Index ix      , Ragged L (Lower ix) e@@ -61,17 +61,16 @@ prop_SliceOuter _ i arr =   expectProp $     if isSafeIndex (fst (unconsSz (size arr))) i-    then do-      e1 <- arr !?> i-      e2 <- arr <!?> (dimensions (size arr), i)-      delay e1 `shouldBe` e2-    else do-      arr !?> i `shouldSatisfy` isNothing-      arr <!?> (dimensions (size arr), i) `shouldSatisfy` isNothing-+      then do+        e1 <- arr !?> i+        e2 <- arr <!?> (dimensions (size arr), i)+        delay e1 `shouldBe` e2+      else do+        arr !?> i `shouldSatisfy` isNothing+        arr <!?> (dimensions (size arr), i) `shouldSatisfy` isNothing -prop_SliceInner ::-     (HasCallStack, Source r e, Index ix, Ragged L (Lower ix) e, Show e, Eq e)+prop_SliceInner+  :: (HasCallStack, Source r e, Index ix, Ragged L (Lower ix) e, Show e, Eq e)   => proxy (r, ix, e)   -> Int   -> Array r ix e@@ -79,14 +78,13 @@ prop_SliceInner _ i arr =   expectProp $ do     if isSafeIndex (snd (unsnocSz (size arr))) i-    then do-      e1 <- arr <!? i-      e2 <- arr <!?> (1, i)-      e1 `shouldBe` e2-    else do-      arr <!? i `shouldSatisfy` isNothing-      arr <!?> (1, i) `shouldSatisfy` isNothing-+      then do+        e1 <- arr <!? i+        e2 <- arr <!?> (1, i)+        e1 `shouldBe` e2+      else do+        arr <!? i `shouldSatisfy` isNothing+        arr <!?> (1, i) `shouldSatisfy` isNothing  prop_SliceIndexDim2 :: (HasCallStack, Source r Int) => ArrIx r Ix2 Int -> Property prop_SliceIndexDim2 (ArrIx arr ix@(i :. j)) =@@ -97,7 +95,6 @@     evaluateM (arr <!> (2, i)) j `shouldReturn` val     evaluateM (arr <!> (1, j)) i `shouldReturn` val - prop_SliceIndexDim3 :: (HasCallStack, Source r Int) => ArrIx r Ix3 Int -> Property prop_SliceIndexDim3 (ArrIx arr ix@(i :> j :. k)) =   expectProp $ do@@ -113,13 +110,12 @@     evaluateM (arr <!> (1, k) <!> (2, i)) j `shouldReturn` val     evaluateM (arr <!> (1, k) <!> (1, j)) i `shouldReturn` val - prop_SliceIndexDim4 :: (HasCallStack, Source r Int) => ArrIx r Ix4 Int -> Property prop_SliceIndexDim4 (ArrIx arr ix@(i1 :> i2 :> i3 :. i4)) =   expectProp $ do     val <- evaluateM arr ix     evaluateM (arr <!> (4, i1) <!> (3, i2) <!> (2, i3)) i4 `shouldReturn` val-    evaluateM (arr <!> (4, i1) <!> (2, i3) <! i4)  i2 `shouldReturn` val+    evaluateM (arr <!> (4, i1) <!> (2, i3) <! i4) i2 `shouldReturn` val     evaluateM (arr <!> (3, i2) <!> (3, i1)) (i3 :. i4) `shouldReturn` val     evaluateM (arr <!> (2, i3) <!> (2, i2)) (i1 :. i4) `shouldReturn` val     evaluateM (arr <!> (2, i3) <!> (1, i4) !> i1) i2 `shouldReturn` val@@ -134,15 +130,11 @@     evaluateM (arr <! i4 <! i3 <! i2) i1 `shouldReturn` val     evaluateM (arr <! i4 <! i3 !> i1) i2 `shouldReturn` val ----specSliceN ::-     ( HasCallStack+specSliceN+  :: ( HasCallStack      , Source r e      , Load r ix e-     , Arbitrary ix-     , Arbitrary e+     , Arbitrary (Array r ix e)      , Show (Array r ix e)      , Ragged L (Lower ix) e      , Show e@@ -155,8 +147,6 @@   describe "Slice" $ do     prop "SliceOuter" $ prop_SliceOuter proxy     prop "SliceInner" $ prop_SliceInner proxy--  spec :: Spec spec = do
tests/Test/Massiv/Array/Ops/SortSpec.hs view
@@ -1,13 +1,14 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeApplications #-}+ module Test.Massiv.Array.Ops.SortSpec (spec) where +import Data.Foldable as F import Data.List as L+import Data.Map.Strict as M import Data.Massiv.Array as A import Test.Massiv.Core as A-import Data.Foldable as F-import Data.Map.Strict as M  prop_IsSorted :: (b -> b) -> ([Int] -> b) -> (b -> [Int]) -> [Int] -> Property prop_IsSorted sortWith from to xs =@@ -19,12 +20,11 @@     addCount :: Word -> Map Word Int -> Map Word Int     addCount !el !counter = M.insertWith (+) el 1 counter - spec :: Spec spec = do   describe "QuickSort" $ do     it "Seq" $ property $ prop_IsSorted (quicksort @P) (A.fromList Seq) A.toList     it "Par" $ property $ prop_IsSorted (quicksort @P) (A.fromList (ParN 4)) A.toList   describe "Tally" $-    prop "Same as Map" $ \ arr ->-       M.toList (tallyMap arr) === F.toList (tally arr)+    prop "Same as Map" $ \arr ->+      M.toList (tallyMap arr) === F.toList (tally arr)
tests/Test/Massiv/Array/Ops/TransformSpec.hs view
@@ -6,21 +6,23 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}+ module Test.Massiv.Array.Ops.TransformSpec (spec) where  import Data.Foldable as F (foldl', toList) import Data.Massiv.Array as A import Data.Maybe import Data.Sequence as S-import Prelude as P-import Test.Massiv.Core import Test.Massiv.Array.Delayed (stackSlices')+import Test.Massiv.Core+import Prelude as P  prop_TransposeOuterInner :: Matrix D Int -> Property prop_TransposeOuterInner arr = transposeOuter arr === transpose arr -prop_UpsampleDownsample ::-     forall r ix e . (Eq (Array r ix e), Show (Array r ix e), Load r ix e, Manifest r e)+prop_UpsampleDownsample+  :: forall r ix e+   . (Eq (Array r ix e), Show (Array r ix e), Load r ix e, Manifest r e)   => ArrTiny r ix e   -> Stride ix   -> e@@ -28,17 +30,18 @@ prop_UpsampleDownsample (ArrTiny arr) stride fill =   arr === compute (downsample stride (compute @r (upsample fill stride arr))) -prop_ExtractAppend ::-     forall r ix e. (Eq (Array r ix e), Show (Array r ix e), Manifest r e, Index ix)+prop_ExtractAppend+  :: forall r ix e+   . (Eq (Array r ix e), Show (Array r ix e), Manifest r e, Index ix)   => DimIx ix   -> ArrIx r ix e   -> Property prop_ExtractAppend (DimIx dim) (ArrIx arr ix) =   arr === compute (uncurry (append' dim) $ A.splitAt' dim (getDim' ix dim) arr) -prop_SplitExtract ::-     forall r ix e.-     ( Eq e+prop_SplitExtract+  :: forall r ix e+   . ( Eq e      , Show e      , Eq (Array r ix e)      , Show (Array r ix e)@@ -52,30 +55,32 @@   -> Positive Int   -> Property prop_SplitExtract (DimIx dim) (ArrIx arr ix) (Positive n) =-  (compute @r <$> splitAt' dim i arr) === (left, compute @r (append' dim center right)) .&&.-  (compute @r splitLeft, splitRight) === (compute @r (append' dim left center), right)-  where i = getDim' ix dim-        k = getDim' (unSz (size arr)) dim-        n' = n `mod` (k - i)-        (left, center, right) = throwEither (splitExtractM dim i (Sz n') arr)-        (splitLeft, splitRight) = splitAt' dim (i + n') arr+  ((compute @r <$> splitAt' dim i arr) === (left, compute @r (append' dim center right)))+    .&&. ((compute @r splitLeft, splitRight) === (compute @r (append' dim left center), right))+  where+    i = getDim' ix dim+    k = getDim' (unSz (size arr)) dim+    n' = n `mod` (k - i)+    (left, center, right) = throwEither (splitExtractM dim i (Sz n') arr)+    (splitLeft, splitRight) = splitAt' dim (i + n') arr -prop_ConcatAppend ::-     forall r ix. (Eq (Array r ix Int), Show (Array r ix Int), Load r ix Int, Manifest r Int)+prop_ConcatAppend+  :: forall r ix+   . (Eq (Array r ix Int), Show (Array r ix Int), Load r ix Int, Manifest r Int)   => DimIx ix   -> Comp   -> Sz ix   -> NonEmptyList (Fun ix Int)   -> Property prop_ConcatAppend (DimIx dim) comp sz (NonEmpty fns) =-  foldl1 (\arr -> compute @r . append' dim arr) arrs ===-  compute @r (concat' dim arrs)+  foldl1 (\arr -> compute @r . append' dim arr) arrs+    === compute @r (concat' dim arrs)   where-    arrs = P.zipWith (\ f i -> makeArray @r comp sz ((+i) . apply f)) fns [0 .. ]+    arrs = P.zipWith (\f i -> makeArray @r comp sz ((+ i) . apply f)) fns [0 ..] -prop_ConcatMConcatOuterM ::-     forall r ix.-     (Eq (Array r ix Int), Show (Array r ix Int), Load r ix Int, Manifest r Int)+prop_ConcatMConcatOuterM+  :: forall r ix+   . (Eq (Array r ix Int), Show (Array r ix Int), Load r ix Int, Manifest r Int)   => Comp   -> Sz ix   -> NonEmptyList (Fun ix Int)@@ -86,8 +91,7 @@     as' <- compute @r <$> concatOuterM (P.map toLoadArray arrs)     as `shouldBe` as'   where-    arrs = P.zipWith (\ f i -> makeArray @r comp sz ((+i) . apply f)) fns [0 .. ]-+    arrs = P.zipWith (\f i -> makeArray @r comp sz ((+ i) . apply f)) fns [0 ..]  prop_AppendMappend   :: Array D Ix1 Int -> Array D Ix1 Int -> Property@@ -99,10 +103,10 @@ prop_ConcatMconcat arrs =   computeAs P (concat' 1 (A.empty : arrs)) === computeAs P (mconcat (fmap toLoadArray arrs)) -prop_ExtractSizeMismatch ::-     (Size r, Load r ix e, NFData (Array r Int e)) => ArrTiny r ix e -> Positive Int -> Property+prop_ExtractSizeMismatch+  :: (Size r, Load r ix e, NFData (Array r Int e)) => ArrTiny r ix e -> Positive Int -> Property prop_ExtractSizeMismatch (ArrTiny arr) (Positive n) =-  assertExceptionIO (SizeElementsMismatchException sz sz' ==) $ resizeM sz' arr+  assertDeepExceptionIO (SizeElementsMismatchException sz sz' ==) $ resizeM sz' arr   where     sz = size arr     sz' = Sz (totalElem sz + n)@@ -119,20 +123,22 @@ --   => ArrNE P ix Int --   -> Property -- prop_stackInnerSlices (ArrNE arr) =---   arr === compute (throwEither (stackInnerSlicesM (innerSlices arr))) .&&.---   arr === compute (stackSlices' 1 (innerSlices arr))+--   (arr === compute (throwEither (stackInnerSlicesM (innerSlices arr)))) .&&.+--   (arr === compute (stackSlices' 1 (innerSlices arr))) prop_stackInnerSlicesIx2 :: ArrNE P Ix2 Int -> Property prop_stackInnerSlicesIx2 (ArrNE arr) =-  arr === compute (throwEither (stackInnerSlicesM (innerSlices arr))) .&&.-  arr === compute (stackSlices' 1 (innerSlices arr))+  (arr === compute (throwEither (stackInnerSlicesM (innerSlices arr))))+    .&&. (arr === compute (stackSlices' 1 (innerSlices arr)))+ prop_stackInnerSlicesIx3 :: ArrNE P Ix3 Int -> Property prop_stackInnerSlicesIx3 (ArrNE arr) =-  arr === compute (throwEither (stackInnerSlicesM (innerSlices arr))) .&&.-  arr === compute (stackSlices' 1 (innerSlices arr))+  (arr === compute (throwEither (stackInnerSlicesM (innerSlices arr))))+    .&&. (arr === compute (stackSlices' 1 (innerSlices arr)))+ prop_stackInnerSlicesIx4 :: ArrNE P Ix4 Int -> Property prop_stackInnerSlicesIx4 (ArrNE arr) =-  arr === compute (throwEither (stackInnerSlicesM (innerSlices arr))) .&&.-  arr === compute (stackSlices' 1 (innerSlices arr))+  (arr === compute (throwEither (stackInnerSlicesM (innerSlices arr))))+    .&&. (arr === compute (stackSlices' 1 (innerSlices arr)))  -- prop_stackOuterSlices :: --      forall ix.@@ -145,28 +151,27 @@ --   => ArrNE P ix Int --   -> Property -- prop_stackOuterSlices (ArrNE arr) =---   arr === compute (throwEither (stackOuterSlicesM (outerSlices arr))) .&&.---   arr === compute (stackSlices' (dimensions (Proxy :: Proxy ix)) (outerSlices arr))+--   (arr === compute (throwEither (stackOuterSlicesM (outerSlices arr)))) .&&.+--   (arr === compute (stackSlices' (dimensions (Proxy :: Proxy ix)) (outerSlices arr)))+ prop_stackOuterSlicesIx2 :: ArrNE P Ix2 Int -> Property prop_stackOuterSlicesIx2 (ArrNE arr) =-  arr === compute (throwEither (stackOuterSlicesM (outerSlices arr))) .&&.-  arr === compute (stackSlices' (dimensions (Proxy :: Proxy Ix2)) (outerSlices arr))+  (arr === compute (throwEither (stackOuterSlicesM (outerSlices arr))))+    .&&. (arr === compute (stackSlices' (dimensions (Proxy :: Proxy Ix2)) (outerSlices arr)))+ prop_stackOuterSlicesIx3 :: ArrNE P Ix3 Int -> Property prop_stackOuterSlicesIx3 (ArrNE arr) =-  arr === compute (throwEither (stackOuterSlicesM (outerSlices arr))) .&&.-  arr === compute (stackSlices' (dimensions (Proxy :: Proxy Ix3)) (outerSlices arr))+  (arr === compute (throwEither (stackOuterSlicesM (outerSlices arr))))+    .&&. (arr === compute (stackSlices' (dimensions (Proxy :: Proxy Ix3)) (outerSlices arr)))+ prop_stackOuterSlicesIx4 :: ArrNE P Ix4 Int -> Property prop_stackOuterSlicesIx4 (ArrNE arr) =-  arr === compute (throwEither (stackOuterSlicesM (outerSlices arr))) .&&.-  arr === compute (stackSlices' (dimensions (Proxy :: Proxy Ix4)) (outerSlices arr))----+  (arr === compute (throwEither (stackOuterSlicesM (outerSlices arr))))+    .&&. (arr === compute (stackSlices' (dimensions (Proxy :: Proxy Ix4)) (outerSlices arr))) -prop_ZoomWithGridStrideCompute ::-     forall r ix e.-     ( Eq (Array r ix e)+prop_ZoomWithGridStrideCompute+  :: forall r ix e+   . ( Eq (Array r ix e)      , Show (Array r ix e)      , StrideLoad r ix e      , Manifest r e@@ -176,16 +181,18 @@   -> e   -> Property prop_ZoomWithGridStrideCompute arr stride defVal =-  (computeWithStride @r stride' arr' ===-   compute (A.replicate @DL Seq (Sz (liftIndex (+ 1) $ unSz (size arr))) defVal)) .&&.-  (computeWithStride @r stride' (extract' (pureIndex 1) sz' arr') === compute arr)+  ( computeWithStride @r stride' arr'+      === compute (A.replicate @DL Seq (Sz (liftIndex (+ 1) $ unSz (size arr))) defVal)+  )+    .&&. (computeWithStride @r stride' (extract' (pureIndex 1) sz' arr') === compute arr)   where     arr' = compute @r (zoomWithGrid defVal stride arr)     sz' = Sz (liftIndex (subtract 1) $ unSz (size arr'))     stride' = Stride (liftIndex (+ 1) $ unStride stride) -prop_ZoomStrideCompute ::-     forall r ix e. (Eq (Array r ix e), Show (Array r ix e), StrideLoad r ix e, Manifest r e)+prop_ZoomStrideCompute+  :: forall r ix e+   . (Eq (Array r ix e), Show (Array r ix e), StrideLoad r ix e, Manifest r e)   => Array r ix e   -> Stride ix   -> Property@@ -193,34 +200,36 @@   where     arr' = compute @r (zoom stride arr) --type Transform r ix e-   = ( Show e-     , Eq e-     , Arbitrary e-     , Arbitrary ix-     , Typeable e-     , Typeable ix-     , CoArbitrary e-     , CoArbitrary ix-     , Function e-     , Function ix-     , Eq (Array r ix e)-     , Eq (Array r ix Int)-     , Show (Array r ix e)-     , Show (Array r ix Int)-     , NFData (Array r ix e)-     , NFData (Array r Int e)-     , Load r ix e-     , Load r ix Int-     , Ragged L ix e-     , Source r e-     , StrideLoad r ix e-     , Manifest r Int-     , Manifest r e)+type Transform r ix e =+  ( Show e+  , Eq e+  , Arbitrary e+  , Arbitrary ix+  , Arbitrary (Array r ix e)+  , Typeable e+  , Typeable ix+  , CoArbitrary e+  , CoArbitrary ix+  , Function e+  , Function ix+  , Eq (Array r ix e)+  , Eq (Array r ix Int)+  , Show (Array r ix e)+  , Show (Array r ix Int)+  , NFData (Array r ix e)+  , NFData (Array r Int e)+  , Load r ix e+  , Load r ix Int+  , Ragged L ix e+  , Source r e+  , StrideLoad r ix e+  , Manifest r Int+  , Manifest r e+  ) -specTransformR ::-     forall r ix e. Transform r ix e+specTransformR+  :: forall r ix e+   . Transform r ix e   => Spec specTransformR =   describe ("Transform (" ++ showsArrayType @r @ix @e ")") $ do@@ -260,7 +269,6 @@     prop "Ix3 - Outer" prop_stackOuterSlicesIx3     prop "Ix4 - Outer" prop_stackOuterSlicesIx4 - prop_UnconsUnsnoc :: Array D Ix1 Int -> Bool -> Property prop_UnconsUnsnoc arr unconsFirst =   preJust $ do@@ -281,8 +289,8 @@  prop_ConsSnoc :: Array D Ix1 Int -> [SeqOp Int] -> Property prop_ConsSnoc arr ops =-  A.toList (computeAs U (foldl' applyArraySeqOp (toLoadArray arr) ops)) ===-  F.toList (foldl' applySequenceSeqOp (S.fromList (A.toList arr)) ops)+  A.toList (computeAs U (foldl' applyArraySeqOp (toLoadArray arr) ops))+    === F.toList (foldl' applySequenceSeqOp (S.fromList (A.toList arr)) ops)  data SeqOp e = Cons e | Snoc e deriving (Eq, Show) @@ -295,7 +303,6 @@ applyArraySeqOp arr = \case   Cons x -> A.cons x arr   Snoc x -> A.snoc arr x-  applySequenceSeqOp :: Seq a -> SeqOp a -> Seq a applySequenceSeqOp arr = \case
tests/Test/Massiv/Array/StencilSpec.hs view
@@ -7,72 +7,83 @@ {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}+ module Test.Massiv.Array.StencilSpec (spec) where -import Prelude as P import Data.Massiv.Array as A import Data.Massiv.Array.Unsafe as A import Test.Massiv.Core+import Prelude as P  avg3x3Stencil :: Fractional a => Stencil Ix2 a a-avg3x3Stencil = (/9) <$> makeConvolutionStencil (Sz 3) (1 :. 1) $ \ get ->-  get (-1 :. -1) 1 . get (-1 :. 0) 1 . get (-1 :. 1) 1 .-  get ( 0 :. -1) 1 . get ( 0 :. 0) 1 . get ( 0 :. 1) 1 .-  get ( 1 :. -1) 1 . get ( 1 :. 0) 1 . get ( 1 :. 1) 1-+avg3x3Stencil = (/ 9) <$> makeConvolutionStencil (Sz 3) (1 :. 1) $ \get ->+  get (-1 :. -1) 1+    . get (-1 :. 0) 1+    . get (-1 :. 1) 1+    . get (0 :. -1) 1+    . get (0 :. 0) 1+    . get (0 :. 1) 1+    . get (1 :. -1) 1+    . get (1 :. 0) 1+    . get (1 :. 1) 1  singletonStencil :: (Index ix) => (Int -> Int) -> Stencil ix Int Int singletonStencil f =-  makeStencil oneSz zeroIndex $ \ get -> f (get zeroIndex)-+  makeStencil oneSz zeroIndex $ \get -> f (get zeroIndex) -prop_MapSingletonStencil :: (Load DW ix Int, Show (Array P ix Int)) =>-                            Proxy ix -> Fun Int Int -> Border Int -> ArrNE P ix Int -> Property+prop_MapSingletonStencil+  :: (Load DW ix Int, Show (Array P ix Int))+  => Proxy ix+  -> Fun Int Int+  -> Border Int+  -> ArrNE P ix Int+  -> Property prop_MapSingletonStencil _ f b (ArrNE arr) =   computeAs P (mapStencil b (singletonStencil (apply f)) arr) === computeAs P (A.map (apply f) arr) -prop_ApplyZeroStencil ::-     (Load DW ix Int, Show (Array P ix Int)) => Proxy ix -> Int -> Array P ix Int -> Property+prop_ApplyZeroStencil+  :: (Load DW ix Int, Show (Array P ix Int)) => Proxy ix -> Int -> Array P ix Int -> Property prop_ApplyZeroStencil _ e arr =   computeAs P (applyStencil noPadding zeroStencil arr) === makeArray Seq (size arr) (const e)   where     zeroStencil = makeStencil zeroSz zeroIndex $ const e --prop_MapSingletonStencilWithStride ::-     (StrideLoad DW ix Int, Show (Array P ix Int))+prop_MapSingletonStencilWithStride+  :: (StrideLoad DW ix Int, Show (Array P ix Int))   => Proxy ix   -> Fun Int Int   -> Border Int   -> ArrNE P ix Int   -> Property prop_MapSingletonStencilWithStride _ f b (ArrNE arr) =-  computeWithStride oneStride (mapStencil b (singletonStencil (apply f)) arr) ===-  computeAs P (A.map (apply f) arr)+  computeWithStride oneStride (mapStencil b (singletonStencil (apply f)) arr)+    === computeAs P (A.map (apply f) arr)  -- Tests out of bounds stencil indexing-prop_DangerousStencil ::-     forall ix. Load DW ix Int+prop_DangerousStencil+  :: forall ix+   . Load DW ix Int   => Proxy ix   -> DimIx ix   -> SzIx ix   -> Property prop_DangerousStencil _ (DimIx r) (SzIx sz center) =-  assertException selectErrorCall arr+  assertDeepException selectErrorCall arr   where     stencil = makeStencil sz center $ \get -> get ix' :: Int     arr = computeAs P (mapStencil Edge stencil (makeArray Seq sz (const 0) :: Array P ix Int))-    ix' = liftIndex2 (-)-          (setDim' zeroIndex r (getDim' (unSz sz) r))-          (setDim' zeroIndex r (getDim' center r))-+    ix' =+      liftIndex2+        (-)+        (setDim' zeroIndex r (getDim' (unSz sz) r))+        (setDim' zeroIndex r (getDim' center r))  instance Index ix => Show (Stencil ix a b) where   show stencil =     "Stencil " ++ show (getStencilSize stencil) ++ " " ++ show (getStencilCenter stencil) -unsafeMapStencil ::-     (Index ix, Manifest r e)+unsafeMapStencil+  :: (Index ix, Manifest r e)   => Border e   -> Sz ix   -> ix@@ -93,9 +104,8 @@     !windowSz = Sz (liftIndex2 (-) (unSz sz) (liftIndex (subtract 1) (unSz sSz)))     stencil getVal !ix = stencilF ix $ \ !ixD -> getVal (liftIndex2 (+) ix ixD) --prop_MapEqApplyStencil ::-     (Show (Array P ix Int), StrideLoad DW ix Int)+prop_MapEqApplyStencil+  :: (Show (Array P ix Int), StrideLoad DW ix Int)   => Stride ix   -> SzTiny ix   -> Border Int@@ -103,18 +113,18 @@   -> Property prop_MapEqApplyStencil stride (SzTiny sz) b arr =   expectProp $-  A.forM_ stencils $ \(_name, stencil, g) -> do-    -- TODO: Instead of removing deprecated unsafeMapStencil move it here for testing when-    -- removed from massiv.-    computeAs P (unsafeMapStencil b sz zeroIndex (const g) arr) `shouldBe`-      computeAs P (applyStencil (samePadding stencil b) stencil arr)-    computeWithStrideAs P stride (unsafeMapStencil b sz zeroIndex (const g) arr) `shouldBe`-      computeWithStrideAs P stride (applyStencil (samePadding stencil b) stencil arr)+    A.forM_ stencils $ \(_name, stencil, g) -> do+      -- TODO: Instead of removing deprecated unsafeMapStencil move it here for testing when+      -- removed from massiv.+      computeAs P (unsafeMapStencil b sz zeroIndex (const g) arr)+        `shouldBe` computeAs P (applyStencil (samePadding stencil b) stencil arr)+      computeWithStrideAs P stride (unsafeMapStencil b sz zeroIndex (const g) arr)+        `shouldBe` computeWithStrideAs P stride (applyStencil (samePadding stencil b) stencil arr)   where     stencils = mkCommonStencils sz -mkCommonStencils ::-     (Bounded a, Num a, Ord a, Index ix)+mkCommonStencils+  :: (Bounded a, Num a, Ord a, Index ix)   => Sz ix   -> Array B Ix1 (String, Stencil ix a a, (ix -> a) -> a) mkCommonStencils sz =@@ -167,21 +177,19 @@     prop "Ix3" $ prop_FoldrStencil @Ix3     prop "Ix4" $ prop_FoldrStencil @Ix4   describe "Simple" $ do-    prop "sumStencil" $ \ (arr :: Array B Ix2 Rational) border ->-      computeAs BN (mapStencil border avg3x3Stencil arr) ===-      computeAs BN (applyStencil (Padding 1 1 border) (avgStencil (Sz 3)) arr)-    prop "sameSizeAndCenter" $ \ (SzIx sz ix) ->+    prop "sumStencil" $ \(arr :: Array B Ix2 Rational) border ->+      computeAs BN (mapStencil border avg3x3Stencil arr)+        === computeAs BN (applyStencil (Padding 1 1 border) (avgStencil (Sz 3)) arr)+    prop "sameSizeAndCenter" $ \(SzIx sz ix) ->       let stencil = makeStencil sz ix ($ Ix1 0) :: Stencil Ix1 Int Int-      in getStencilSize stencil === sz .&&. getStencilCenter stencil === ix+       in getStencilSize stencil === sz .&&. getStencilCenter stencil === ix  stencilDirection :: Ix2 -> Matrix P Int -> Matrix P Int stencilDirection ix = computeAs P . mapStencil (Fill 0) (makeStencil (Sz 3) (1 :. 1) $ \f -> f ix) - stencilCorners :: Ix2 -> Ix2 -> Matrix P Int -> Matrix P Int stencilCorners ixC ix = computeAs P . mapStencil (Fill 0) (makeStencil (Sz 3) ixC $ \f -> f ix) - stencilConvolution :: Spec stencilConvolution = do   let xs3 :: Array P Ix1 Int@@ -209,11 +217,11 @@     it "1x3 map" $ mapStencil1 (makeConvolutionStencilFromKernel xs3) ys `shouldBe` ysConvXs3     it "1x4 map" $ mapStencil1 (makeConvolutionStencilFromKernel xs4) ys `shouldBe` ysConvXs4     it "1x3 apply" $-      applyStencil1 (makeConvolutionStencilFromKernel xs3) ys `shouldBe`-      compute (extract' 1 3 ysConvXs3)+      applyStencil1 (makeConvolutionStencilFromKernel xs3) ys+        `shouldBe` compute (extract' 1 3 ysConvXs3)     it "1x4 apply" $-      applyStencil1 (makeConvolutionStencilFromKernel xs4) ys `shouldBe`-      compute (extract' 1 2 ysConvXs4)+      applyStencil1 (makeConvolutionStencilFromKernel xs4) ys+        `shouldBe` compute (extract' 1 2 ysConvXs4)   describe "makeCorrelationStencilFromKernel" $ do     it "1x3 map" $ mapStencil1 (makeCorrelationStencilFromKernel xs3) ys `shouldBe` ysCorrXs3     it "1x4 map" $ mapStencil1 (makeCorrelationStencilFromKernel xs4) ys `shouldBe` ysCorrXs4@@ -228,42 +236,42 @@   describe "makeConvolutionStencil == makeConvolutionStencilFromKernel" $ do     it "Sobel Horizontal" $       property $ \(arr :: Array P Ix2 Int) ->-        mapStencil2 (makeConvolutionStencil (Sz 3) 1 sobelX) arr ===-        mapStencil2 (makeConvolutionStencilFromKernel sobelKernelX) arr+        mapStencil2 (makeConvolutionStencil (Sz 3) 1 sobelX) arr+          === mapStencil2 (makeConvolutionStencilFromKernel sobelKernelX) arr     it "1x3" $       property $ \(arr :: Array P Ix1 Int) ->-        mapStencil1 (makeConvolutionStencil (Sz1 3) 1 xs3f) arr ===-        mapStencil1 (makeConvolutionStencilFromKernel xs3) arr+        mapStencil1 (makeConvolutionStencil (Sz1 3) 1 xs3f) arr+          === mapStencil1 (makeConvolutionStencilFromKernel xs3) arr     it "1x4" $       property $ \(arr :: Array P Ix1 Int) ->-        mapStencil1 (makeConvolutionStencil (Sz1 4) 2 xs4f) arr ===-        mapStencil1 (makeConvolutionStencilFromKernel xs4) arr+        mapStencil1 (makeConvolutionStencil (Sz1 4) 2 xs4f) arr+          === mapStencil1 (makeConvolutionStencilFromKernel xs4) arr   describe "makeCorrelationStencil == makeCorrelationStencilFromKernel" $ do     it "Sobel Horizontal" $       property $ \(arr :: Array P Ix2 Int) ->-        mapStencil2 (makeCorrelationStencil (Sz 3) 1 sobelX) arr ===-        mapStencil2 (makeCorrelationStencilFromKernel sobelKernelX) arr+        mapStencil2 (makeCorrelationStencil (Sz 3) 1 sobelX) arr+          === mapStencil2 (makeCorrelationStencilFromKernel sobelKernelX) arr     it "1x3" $       property $ \(arr :: Array P Ix1 Int) ->-        mapStencil1 (makeCorrelationStencil (Sz1 3) 1 xs3f) arr ===-        mapStencil1 (makeCorrelationStencilFromKernel xs3) arr+        mapStencil1 (makeCorrelationStencil (Sz1 3) 1 xs3f) arr+          === mapStencil1 (makeCorrelationStencilFromKernel xs3) arr     it "1x4" $       property $ \(arr :: Array P Ix1 Int) ->-        mapStencil1 (makeCorrelationStencil (Sz1 4) 2 xs4f) arr ===-        mapStencil1 (makeCorrelationStencilFromKernel xs4) arr+        mapStencil1 (makeCorrelationStencil (Sz1 4) 2 xs4f) arr+          === mapStencil1 (makeCorrelationStencilFromKernel xs4) arr   describe "makeConvolutionStencil == makeCorrelationStencil . rotate180" $ do     it "Sobel Horizontal" $       property $ \(arr :: Array P Ix2 Int) ->-        mapStencil2 (makeConvolutionStencilFromKernel sobelKernelX) arr ===-        mapStencil2 (makeCorrelationStencilFromKernel (rotate180 sobelKernelX)) arr+        mapStencil2 (makeConvolutionStencilFromKernel sobelKernelX) arr+          === mapStencil2 (makeCorrelationStencilFromKernel (rotate180 sobelKernelX)) arr     it "1x3" $       property $ \(arr :: Array P Ix1 Int) ->-        mapStencil1 (makeConvolutionStencilFromKernel xs3) arr ===-        mapStencil1 (makeCorrelationStencilFromKernel (rotate180 xs3)) arr+        mapStencil1 (makeConvolutionStencilFromKernel xs3) arr+          === mapStencil1 (makeCorrelationStencilFromKernel (rotate180 xs3)) arr     it "1x5" $       property $ \(arr :: Array P Ix1 Int) ->-        mapStencil1 (makeConvolutionStencilFromKernel ys) arr ===-        mapStencil1 (makeCorrelationStencilFromKernel (rotate180 ys)) arr+        mapStencil1 (makeConvolutionStencilFromKernel ys) arr+          === mapStencil1 (makeCorrelationStencilFromKernel (rotate180 ys)) arr  spec :: Spec spec = do@@ -297,19 +305,25 @@       it "map stencil with stride on larger array" $         let largeArr = makeArrayR P Seq (Sz 5) (succ . toLinearIndex (Sz 5))             strideArr = mapStencil (Fill 0) stencil largeArr-         in computeWithStrideAs P stride strideArr `shouldBe`-            [[-6, 1, 14], [-13, 9, 43], [4, 21, 44]]+         in computeWithStrideAs P stride strideArr+              `shouldBe` [[-6, 1, 14], [-13, 9, 43], [4, 21, 44]]   stencilConvolution  sobelX :: Num e => (Ix2 -> e -> e -> e) -> e -> e-sobelX f = f (-1 :. -1) (-1) . f (-1 :. 1) 1 .-           f ( 0 :. -1) (-2) . f ( 0 :. 1) 2 .-           f ( 1 :. -1) (-1) . f ( 1 :. 1) 1+sobelX f =+  f (-1 :. -1) (-1)+    . f (-1 :. 1) 1+    . f (0 :. -1) (-2)+    . f (0 :. 1) 2+    . f (1 :. -1) (-1)+    . f (1 :. 1) 1  sobelKernelX :: Array P Ix2 Int-sobelKernelX = [ [-1, 0, 1]-               , [-2, 0, 2]-               , [-1, 0, 1] ]+sobelKernelX =+  [ [-1, 0, 1]+  , [-2, 0, 2]+  , [-1, 0, 1]+  ]  rotate180 :: (Num ix, Index ix) => Array P ix Int -> Array P ix Int rotate180 = computeAs P . transform' (\sz -> (sz, sz)) (\(Sz sz) f ix -> f (sz - 1 - ix))
tests/Test/Massiv/ArraySpec.hs view
@@ -3,50 +3,52 @@ {-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}+ -- Here are tests for all instances for all main classes-module Test.Massiv.ArraySpec-  ( spec-  ) where+module Test.Massiv.ArraySpec (+  spec,+) where  import Data.Massiv.Array import Test.Massiv.Core --prop_Construct_makeArray_Manifest ::-     forall r ix. (Ragged L ix Int, Source r Int, Load r ix Int)+prop_Construct_makeArray_Manifest+  :: forall r ix+   . (Ragged L ix Int, Source r Int, Load r ix Int)   => Comp   -> Sz ix   -> Fun Int Int   -> Property prop_Construct_makeArray_Manifest comp sz f =-  makeArrayLinearR D comp sz (apply f) ===-  delay (setComp Seq (makeArray comp sz (apply f . toLinearIndex sz) :: Array r ix Int))+  makeArrayLinearR D comp sz (apply f)+    === delay (setComp Seq (makeArray comp sz (apply f . toLinearIndex sz) :: Array r ix Int)) -prop_Construct_makeArray_Delayed ::-     forall r ix. (Ragged L ix Int, Load r ix Int)+prop_Construct_makeArray_Delayed+  :: forall r ix+   . (Ragged L ix Int, Load r ix Int)   => Comp   -> Sz ix   -> Fun Int Int   -> Property prop_Construct_makeArray_Delayed comp sz f =-  makeArrayLinearR P comp sz (apply f) ===-  compute (setComp Seq (makeArrayLinear comp sz (apply f)) :: Array r ix Int)+  makeArrayLinearR P comp sz (apply f)+    === compute (setComp Seq (makeArrayLinear comp sz (apply f)) :: Array r ix Int) -prop_Functor ::-     forall r ix.-     (Ragged L ix Int, Load r ix Int, Functor (Array r ix))+prop_Functor+  :: forall r ix+   . (Ragged L ix Int, Load r ix Int, Functor (Array r ix))   => Comp   -> Sz ix   -> Fun Int Int   -> Fun Int Int   -> Property prop_Functor comp sz f g =-  makeArrayLinearR P comp sz (apply g . apply f) ===-  compute (fmap (apply g) (makeArrayLinear comp sz (apply f) :: Array r ix Int))+  makeArrayLinearR P comp sz (apply g . apply f)+    === compute (fmap (apply g) (makeArrayLinear comp sz (apply f) :: Array r ix Int)) -prop_Extract ::-     forall r ix.-     ( Ragged L ix Int+prop_Extract+  :: forall r ix+   . ( Ragged L ix Int      , Load r ix Int      , Source r Int      )@@ -57,15 +59,15 @@   -> Sz ix   -> Property prop_Extract comp sz f start newSize =-  (computeAs P <$> toStringException (extractM start newSize arrD))  ===-  (compute <$> toStringException (extractM start newSize arr))+  (computeAs P <$> toStringException (extractM start newSize arrD))+    === (compute <$> toStringException (extractM start newSize arr))   where     arrD = makeArrayLinearR D comp sz (apply f)     arr = makeArrayLinear comp sz (apply f) :: Array r ix Int -prop_IxUnbox ::-     forall ix.-     ( Ragged L ix ix+prop_IxUnbox+  :: forall ix+   . ( Ragged L ix ix      , Source U ix      , Unbox ix      )@@ -74,27 +76,27 @@   -> Fun Int ix   -> Property prop_IxUnbox comp sz f =-  makeArrayLinearR D comp sz (apply f) ===-  delay (makeArrayLinear comp sz (apply f) :: Array U ix ix)+  makeArrayLinearR D comp sz (apply f)+    === delay (makeArrayLinear comp sz (apply f) :: Array U ix ix) -prop_computeWithStride ::-     forall r ix. (Ragged L ix Int, StrideLoad r ix Int)+prop_computeWithStride+  :: forall r ix+   . (Ragged L ix Int, StrideLoad r ix Int)   => Comp   -> Sz ix   -> Fun Int Int   -> Stride ix   -> Property prop_computeWithStride comp sz f stride =-  arr === computeWithStride stride arrL .&&.-  arr === compute (fromStrideLoad stride arrL)+  (arr === computeWithStride stride arrL)+    .&&. (arr === compute (fromStrideLoad stride arrL))   where     arrL = makeArrayLinear comp sz (apply f) :: Array r ix Int     arr = computeWithStrideAs P stride (makeArrayLinearR D comp sz (apply f)) --specCommon ::-     forall ix.-     (Arbitrary ix, StrideLoad DW ix Int, Ragged L ix Int, Ragged L ix ix, Unbox ix)+specCommon+  :: forall ix+   . (Arbitrary ix, StrideLoad DW ix Int, Ragged L ix Int, Ragged L ix ix, Unbox ix)   => Spec specCommon =   describe "Construct" $ do@@ -125,12 +127,12 @@     prop "computeWithStride U" $ prop_computeWithStride @U @ix     prop "IxUnbox" $ prop_IxUnbox @ix - spec :: Spec spec = do   specCommon @Ix1   specCommon @Ix2   specCommon @Ix3-  -- FIXME: Uses too much RAM when compiling-  -- specCommon @Ix4-  -- specCommon @Ix5++-- FIXME: Uses too much RAM when compiling+-- specCommon @Ix4+-- specCommon @Ix5
tests/Test/Massiv/Core/IndexSpec.hs view
@@ -5,23 +5,21 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}+ module Test.Massiv.Core.IndexSpec (spec) where -import Control.Exception import Control.DeepSeq+import Control.Exception import Data.Massiv.Array-import Data.Massiv.Array.Unsafe (Sz(SafeSz))+import Data.Massiv.Array.Unsafe (Sz (SafeSz)) import Test.Massiv.Core.Index import Test.Massiv.Utils-import Test.Validity.Eq (eqSpecOnArbitrary)-import Test.Validity.Ord (ordSpecOnArbitrary) --specIxN ::-     forall ix.-     ( Num ix-     -- , Unbox ix -- TODO: add spec for unboxed vectors-     , Index ix+specIxN+  :: forall ix+   . ( Num ix+     , -- , Unbox ix -- TODO: add spec for unboxed vectors+       Index ix      , Bounded ix      , Index (Lower ix)      , Arbitrary ix@@ -38,34 +36,34 @@   describe "Bounded" $ do     it "minBound" $ fromIntegral (minBound :: Int) `shouldBe` (minBound :: ix)     it "maxBound" $ fromIntegral (maxBound :: Int) `shouldBe` (maxBound :: ix)-  eqSpecOnArbitrary @ix-  ordSpecOnArbitrary @ix+  specLaws $ eqLaws (Proxy @ix)+  specLaws $ ordLaws (Proxy @ix)+  specLaws $ numLaws (Proxy @ix)   describe "Stride" $ do     it "Positive" $       property $ \(ix :: ix) ->         case Stride ix of-          str@(Stride ix') -> foldlIndex (\a x -> a && x > 0) True ix' .&&.-                              unStride str === liftIndex (max 1) ix+          str@(Stride ix') ->+            foldlIndex (\a x -> a && x > 0) True ix'+              .&&. (unStride str === liftIndex (max 1) ix)     it "Show" $ property $ \str -> ("Just (" ++ show (str :: Stride ix) ++ ")") === show (Just str)-    eqSpecOnArbitrary @(Stride ix)-    ordSpecOnArbitrary @(Stride ix)-    it "DeebpSeq" $ property $ \ (str :: Stride ix) -> rnf str `shouldBe` ()+    specLaws $ eqLaws (Proxy @(Stride ix))+    specLaws $ ordLaws (Proxy @(Stride ix))+    it "DeebpSeq" $ property $ \(str :: Stride ix) -> rnf str `shouldBe` ()     it "oneStride" $ unStride oneStride `shouldBe` (1 :: ix)-    it "toLinearIndexStride" $ property $ \ str (SzIx sz ix :: SzIx ix) ->+    it "toLinearIndexStride" $ property $ \str (SzIx sz ix :: SzIx ix) ->       let k = toLinearIndexStride str sz ix           ix' = fromLinearIndex sz k-      in ix' * unStride str + liftIndex2 mod ix (unStride str) === ix-    it "strideSize" $ property $ \ (str :: Stride ix) sz ->+       in ix' * unStride str + liftIndex2 mod ix (unStride str) === ix+    it "strideSize" $ property $ \(str :: Stride ix) sz ->       let sz' = Sz (unSz sz * unStride str) in strideSize str sz' === sz-    it "strideStart" $ property $ \ (str :: Stride ix) ix ->+    it "strideStart" $ property $ \(str :: Stride ix) ix ->       let start = strideStart str ix-      in liftIndex2 mod start (unStride str) === zeroIndex .&&.-         ix <= start-+       in (liftIndex2 mod start (unStride str) === zeroIndex) .&&. (ix <= start) -specIxT ::-     forall ix ix'.-     ( Index ix+specIxT+  :: forall ix ix'+   . ( Index ix      , Index (Lower ix)      , Arbitrary ix      , Arbitrary (Lower ix)@@ -77,7 +75,7 @@ specIxT fromIxT toIxT = describe (showsTypeRep (typeRep (Proxy :: Proxy ix)) "") $ do   ixSpec @ix   ix2UpSpec @ix-  it "toFromIx" $ property $ \ ix -> ix === toIxT (fromIxT ix)+  it "toFromIx" $ property $ \ix -> ix === toIxT (fromIxT ix)  specPatterns :: Spec specPatterns =@@ -123,12 +121,11 @@         case Sz (i5 :> i4 :> i3 :> i2 :. i1) of           Sz5 i5' i4' i3' i2' i1' -> SafeSz (i5' :> i4' :> i3' :> i2' :. i1') === Sz5 i5 i4 i3 i2 i1 --specSz ::-     forall ix.-     ( Num ix-     -- , Unbox ix -- TODO: add Unbox instance and a spec for unboxed vectors-     , Index ix+specSz+  :: forall ix+   . ( Num ix+     , -- , Unbox ix -- TODO: add Unbox instance and a spec for unboxed vectors+       Index ix      , Arbitrary ix      )   => Spec@@ -137,8 +134,8 @@     szSpec @ix     szNumSpec @ix     prop "Show" $ \sz -> ("Just (" ++ show (sz :: Sz ix) ++ ")") === show (Just sz)-  eqSpecOnArbitrary @(Sz ix)-  ordSpecOnArbitrary @(Sz ix)+  specLaws $ eqLaws (Proxy @(Sz ix))+  specLaws $ ordLaws (Proxy @(Sz ix))  specIx :: Spec specIx = do@@ -170,6 +167,6 @@   specSz @Ix5   describe "NFData Border" $ do     it "Fill exception" $-      assertException (ExpectedException==) (Fill (throw ExpectedException :: Int))-    it "rnf" $ property $ \ (b :: Border Int) -> rnf b `shouldBe` ()-  eqSpecOnArbitrary @(Border Int)+      assertDeepException (ExpectedException ==) (Fill (throw ExpectedException :: Int))+    it "rnf" $ property $ \(b :: Border Int) -> rnf b `shouldBe` ()+  specLaws $ eqLaws (Proxy @(Border Int))
tests/Test/Massiv/Core/ListSpec.hs view
@@ -4,14 +4,14 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}+ module Test.Massiv.Core.ListSpec (spec) where  import Data.Massiv.Array-import Test.Massiv.Core import Test.Massiv.Array.Delayed-+import Test.Massiv.Core  spec :: Spec spec = do-  describe "L" $-    it "toStream" $ property (prop_toStreamIsList @L @Int)+  describe "L" $ do+    prop "toStream" $ prop_toStreamIsList @L @Int
tests/Test/Massiv/Core/SchedulerSpec.hs view
@@ -1,45 +1,50 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}+ module Test.Massiv.Core.SchedulerSpec (spec) where -import Control.Exception.Base (ArithException(DivideByZero))+import Control.Exception.Base (ArithException (DivideByZero)) import Data.Massiv.Array as A import Test.Massiv.Core import Prelude as P - -- | Ensure proper exception handling. prop_CatchDivideByZero :: ArrIx D Ix2 Int -> [Int] -> Property prop_CatchDivideByZero (ArrIx arr ix) caps =-  assertException+  assertDeepException     (== DivideByZero)-    (A.sum $-     A.imap-       (\ix' x ->-          if ix == ix'-            then x `div` 0-            else x)-       (setComp (ParOn caps) arr))+    ( A.sum $+        A.imap+          ( \ix' x ->+              if ix == ix'+                then x `div` 0+                else x+          )+          (setComp (ParOn caps) arr)+    )  -- | Ensure proper exception handling in nested parallel computation prop_CatchNested :: ArrIx D Ix1 (ArrIx D Ix1 Int) -> [Int] -> Property prop_CatchNested (ArrIx arr ix) caps =-  assertException+  assertDeepException     (== DivideByZero)-    (computeAs U $-     A.map A.sum $-     A.imap-       (\ix' (ArrIx iarr ixi) ->-          if ix == ix'-            then A.imap-                   (\ixi' e ->-                      if ixi == ixi'-                        then e `div` 0-                        else e)-                   iarr-            else iarr)-       (setComp (ParOn caps) arr))-+    ( computeAs U $+        A.map A.sum $+          A.imap+            ( \ix' (ArrIx iarr ixi) ->+                if ix == ix'+                  then+                    A.imap+                      ( \ixi' e ->+                          if ixi == ixi'+                            then e `div` 0+                            else e+                      )+                      iarr+                  else iarr+            )+            (setComp (ParOn caps) arr)+    )  spec :: Spec spec =
tests/Test/Massiv/VectorSpec.hs view
@@ -5,20 +5,21 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}+ module Test.Massiv.VectorSpec (spec) where -import Control.Arrow (first) import Control.Applicative+import Control.Arrow (first) import Control.Exception import Data.Bits import Data.Int-import qualified Data.Tuple as Tuple import qualified Data.List as List import Data.Massiv.Array as A import Data.Massiv.Array.Unsafe as A import Data.Massiv.Vector as V import Data.Maybe import Data.Primitive.MutVar+import qualified Data.Tuple as Tuple import qualified Data.Vector as VB import qualified Data.Vector.Primitive as VP import qualified Data.Vector.Storable as VS@@ -30,8 +31,8 @@  infix 4 !==!, !!==!! -toUnboxV2 ::-     Unbox e+toUnboxV2+  :: Unbox e   => (VU.Vector e1 -> VU.Vector e2 -> VU.Vector e)   -> Array U ix1 e1   -> Array U ix2 e2@@ -39,8 +40,8 @@ toUnboxV2 f v1 v2 =   fromUnboxedVector (getComp v1 <> getComp v2) (f (toUnboxedVector v1) (toUnboxedVector v2)) -toUnboxV3 ::-     Unbox e+toUnboxV3+  :: Unbox e   => (VU.Vector e1 -> VU.Vector e2 -> VU.Vector e3 -> VU.Vector e)   -> Array U ix1 e1   -> Array U ix2 e2@@ -48,8 +49,8 @@   -> Array U Ix1 e toUnboxV3 f v1 v2 v3 = appComp (getComp v1) (toUnboxV2 (f (toUnboxedVector v1)) v2 v3) -toUnboxV4 ::-     Unbox e+toUnboxV4+  :: Unbox e   => (VU.Vector e1 -> VU.Vector e2 -> VU.Vector e3 -> VU.Vector e4 -> VU.Vector e)   -> Array U ix1 e1   -> Array U ix2 e2@@ -58,8 +59,8 @@   -> Array U Ix1 e toUnboxV4 f v1 v2 v3 v4 = appComp (getComp v1) (toUnboxV3 (f (toUnboxedVector v1)) v2 v3 v4) -toUnboxV5 ::-     Unbox e+toUnboxV5+  :: Unbox e   => (VU.Vector e1 -> VU.Vector e2 -> VU.Vector e3 -> VU.Vector e4 -> VU.Vector e5 -> VU.Vector e)   -> Array U ix1 e1   -> Array U ix2 e2@@ -69,8 +70,8 @@   -> Array U Ix1 e toUnboxV5 f v1 v2 v3 v4 v5 = appComp (getComp v1) (toUnboxV4 (f (toUnboxedVector v1)) v2 v3 v4 v5) -toUnboxV6 ::-     Unbox e+toUnboxV6+  :: Unbox e   => (VU.Vector e1 -> VU.Vector e2 -> VU.Vector e3 -> VU.Vector e4 -> VU.Vector e5 -> VU.Vector e6 -> VU.Vector e)   -> Array U ix1 e1   -> Array U ix2 e2@@ -85,8 +86,8 @@ toPrimV2 :: (Index ix) => (VP.Vector e1 -> VP.Vector e2 -> t) -> Array P ix e1 -> Array P ix e2 -> t toPrimV2 f v1 v2 = f (toPrimitiveVector v1) (toPrimitiveVector v2) -toPrimV3 ::-     Index ix+toPrimV3+  :: Index ix   => (VP.Vector e -> VP.Vector e1 -> VP.Vector e2 -> t)   -> Array P ix e   -> Array P ix e1@@ -94,8 +95,8 @@   -> t toPrimV3 f v1 = toPrimV2 (f (toPrimitiveVector v1)) -toPrimV4 ::-     Index ix+toPrimV4+  :: Index ix   => (VP.Vector e1 -> VP.Vector e2 -> VP.Vector e3 -> VP.Vector e4 -> t)   -> Array P ix e1   -> Array P ix e2@@ -104,8 +105,8 @@   -> t toPrimV4 f v1 = toPrimV3 (f (toPrimitiveVector v1)) -toPrimV5 ::-     Index ix+toPrimV5+  :: Index ix   => (VP.Vector e -> VP.Vector e1 -> VP.Vector e2 -> VP.Vector e3 -> VP.Vector e4 -> t)   -> Array P ix e   -> Array P ix e1@@ -115,8 +116,8 @@   -> t toPrimV5 f v1 = toPrimV4 (f (toPrimitiveVector v1)) -toPrimV6 ::-     Index ix+toPrimV6+  :: Index ix   => (VP.Vector e -> VP.Vector e1 -> VP.Vector e2 -> VP.Vector e3 -> VP.Vector e4 -> VP.Vector e5 -> t)   -> Array P ix e   -> Array P ix e1@@ -127,12 +128,12 @@   -> t toPrimV6 f v1 = toPrimV5 (f (toPrimitiveVector v1)) --(!==!) :: (Eq e, Show e, Prim e, Load r Ix1 e) => V.Vector r e -> VP.Vector e -> Property+(!==!)+  :: (Eq e, Show e, Prim e, Load r Ix1 e) => V.Vector r e -> VP.Vector e -> Property (!==!) arr vec = toPrimitiveVector (convert arr) === vec -(!!==!!) ::-     (Eq e, Show e, Prim e, Load r Ix1 e) => V.Vector r e -> VP.Vector e -> Property+(!!==!!)+  :: (Eq e, Show e, Prim e, Load r Ix1 e) => V.Vector r e -> VP.Vector e -> Property (!!==!!) arr vec = property $ do   eRes <- try (pure $! vec)   case eRes of@@ -148,48 +149,51 @@ withSeed :: forall a. SeedVector -> (forall s. MWC.Gen s -> ST s a) -> a withSeed (SeedVector seed) f = runST $ MWC.initialize seed >>= f -withSeed2 ::-     forall a. (Eq a, Show a)+withSeed2+  :: forall a+   . (Eq a, Show a)   => SeedVector   -> (forall s. MWC.Gen s -> ST s a)   -> (forall s. MWC.Gen s -> ST s a)   -> Property withSeed2 seed f g = withSeed @a seed f === withSeed seed g -withSeedV2 ::-     forall r e. (Eq e, Show e, Prim e, Load r Ix1 e)+withSeedV2+  :: forall r e+   . (Eq e, Show e, Prim e, Load r Ix1 e)   => SeedVector   -> (forall s. MWC.Gen s -> ST s (V.Vector r e))   -> (forall s. MWC.Gen s -> ST s (VP.Vector e))   -> Property withSeedV2 seed f g = withSeed @(V.Vector r e) seed f !==! withSeed seed g - prop_sreplicateM :: SeedVector -> Int -> Property-prop_sreplicateM seed k = withSeedV2 @DS @Word seed-                          (V.sreplicateM (Sz k) . uniform)-                          (VP.replicateM k . uniform)+prop_sreplicateM seed k =+  withSeedV2 @DS @Word+    seed+    (V.sreplicateM (Sz k) . uniform)+    (VP.replicateM k . uniform)  prop_sgenerateM :: SeedVector -> Int -> Fun Int Word -> Property-prop_sgenerateM seed k f = withSeedV2 @DS @Word seed-                           (genWith (V.sgenerateM (Sz k)))-                           (genWith (VP.generateM k))+prop_sgenerateM seed k f =+  withSeedV2 @DS @Word+    seed+    (genWith (V.sgenerateM (Sz k)))+    (genWith (VP.generateM k))   where     genWith :: PrimMonad f => ((Int -> f Word) -> t) -> MWC.Gen (PrimState f) -> t     genWith genM gen = genM (\i -> xor (apply f i) <$> uniform gen) - prop_siterateNM :: SeedVector -> Int -> Word -> Property prop_siterateNM seed k a =   withSeed @(V.Vector DS Word) seed (genWith (\f -> V.siterateNM (Sz k) f a))-  !==! withSeed seed (genWith (\f -> VP.iterateNM k f a))+    !==! withSeed seed (genWith (\f -> VP.iterateNM k f a))   where     genWith :: PrimMonad f => ((Word -> f Word) -> t) -> MWC.Gen (PrimState f) -> t     genWith genM gen = genM (\prev -> xor prev <$> uniform gen) --genWithUnfoldrM ::-     PrimMonad f => ((Word -> f (Maybe (Word, Word))) -> t) -> MWC.Gen (PrimState f) -> t+genWithUnfoldrM+  :: PrimMonad f => ((Word -> f (Maybe (Word, Word))) -> t) -> MWC.Gen (PrimState f) -> t genWithUnfoldrM genM gen = genM $ \prev -> do   x <- uniform gen   let cur = prev `xor` x@@ -197,32 +201,34 @@  prop_sunfoldrM :: SeedVector -> Word -> Property prop_sunfoldrM seed a =-  withSeedV2 @DS @Word seed-  (genWithUnfoldrM (`V.sunfoldrM` a))-  (genWithUnfoldrM (`VP.unfoldrM`a))+  withSeedV2 @DS @Word+    seed+    (genWithUnfoldrM (`V.sunfoldrM` a))+    (genWithUnfoldrM (`VP.unfoldrM` a))  prop_sunfoldrNM :: SeedVector -> Int -> Word -> Property prop_sunfoldrNM seed k a =-  withSeedV2 @DS @Word seed-  (genWithUnfoldrM (\f -> V.sunfoldrNM (Sz k) f a))-  (genWithUnfoldrM (\f -> VP.unfoldrNM k f a))-  .&&.-  withSeedV2 @DS @Word seed-  (genWithUnfoldrM (\f -> A.unsafeUnfoldrNM (Sz k) f a))-  (genWithUnfoldrM (\f -> VP.unfoldrNM k f a))+  withSeedV2 @DS @Word+    seed+    (genWithUnfoldrM (\f -> V.sunfoldrNM (Sz k) f a))+    (genWithUnfoldrM (\f -> VP.unfoldrNM k f a))+    .&&. withSeedV2 @DS @Word+      seed+      (genWithUnfoldrM (\f -> A.unsafeUnfoldrNM (Sz k) f a))+      (genWithUnfoldrM (\f -> VP.unfoldrNM k f a))  prop_sunfoldrExactNM :: SeedVector -> Int -> Word -> Property prop_sunfoldrExactNM seed k a =-  withSeedV2 @DS @Word seed-  (genWith (\f -> V.sunfoldrExactNM (Sz k) f a))-  (genWith (\f -> VP.unfoldrNM k (fmap Just . f) a))+  withSeedV2 @DS @Word+    seed+    (genWith (\f -> V.sunfoldrExactNM (Sz k) f a))+    (genWith (\f -> VP.unfoldrNM k (fmap Just . f) a))   where     genWith :: PrimMonad f => ((Word -> f (Word, Word)) -> t) -> MWC.Gen (PrimState f) -> t     genWith genM gen = genM $ \prev -> do       x <- uniform gen       pure (x, prev `xor` x) - genWithMapM :: PrimMonad m => ((Word -> m Word) -> m a) -> MWC.Gen (PrimState m) -> m a genWithMapM genM gen = genM $ \e -> xor e <$> uniform gen genWithMapWS :: PrimMonad m => ((Word -> MWC.Gen (PrimState m) -> m Word) -> m a) -> m a@@ -232,13 +238,13 @@ genWithIMapM genM gen = genM $ \i e -> do   ir <- uniformR (0, fromIntegral i) gen   xor ir . xor e <$> uniform gen+ genWithIMapWS :: PrimMonad m => ((Int -> Word -> MWC.Gen (PrimState m) -> m Word) -> m a) -> m a genWithIMapWS genM =   genM $ \i e gen -> do     ir <- uniformR (0, fromIntegral i) gen     xor ir . xor e <$> uniform gen - genWithMapM_ :: PrimMonad m => ((Word -> m ()) -> m ()) -> MWC.Gen (PrimState m) -> m Word genWithMapM_ genM gen = do   ref <- newMutVar =<< uniform gen@@ -259,50 +265,52 @@ prop_straverse :: SeedVector -> Array P Ix2 Word -> Property prop_straverse seed a =   withSeed @(V.Vector DS Word) seed (genWithMapM (`V.straverse` a))-  !==! withSeed seed (genWithMapM (`VP.mapM` toPrimitiveVector a))+    !==! withSeed seed (genWithMapM (`VP.mapM` toPrimitiveVector a))  prop_smapM :: SeedVector -> Array P Ix2 Word -> Property prop_smapM seed a =   withSeed @(V.Vector DS Word) seed (genWithMapM (`V.smapM` a))-  !==! withSeed seed (genWithMapM (`VP.mapM` toPrimitiveVector a))+    !==! withSeed seed (genWithMapM (`VP.mapM` toPrimitiveVector a))  prop_smapMaybeM :: SeedVector -> Array BL Ix2 Word -> Fun Word (Maybe Word16) -> Property prop_smapMaybeM seed a gm =-  withSeed @(V.Vector DS Word16) seed (genWithMapM (\ f -> V.smapMaybeM (fmap g . f) a))-  !==! withSeed seed+  withSeed @(V.Vector DS Word16) seed (genWithMapM (\f -> V.smapMaybeM (fmap g . f) a))+    !==! withSeed+      seed       (genWithMapM (\f -> VP.convert . VB.mapMaybe id <$> VB.mapM (fmap g . f) (toBoxedVector a)))-  where g = apply gm+  where+    g = apply gm  prop_sitraverse :: SeedVector -> Vector P Word -> Property prop_sitraverse seed a =   withSeed @(V.Vector DS Word) seed (genWithIMapM (`V.sitraverse` a))-  !==! withSeed seed (genWithIMapM (\f -> VP.convert <$> VU.mapM (uncurry f) vp))+    !==! withSeed seed (genWithIMapM (\f -> VP.convert <$> VU.mapM (uncurry f) vp))   where     vp = VU.imap (,) $ toUnboxedVector (compute a)  prop_simapM :: SeedVector -> Vector U Word -> Property prop_simapM seed a =   withSeed @(V.Vector DS Word) seed (genWithIMapM (V.siforM a))-  !==! withSeed seed (genWithIMapM (\f -> VP.convert <$> VU.mapM (uncurry f) vp))+    !==! withSeed seed (genWithIMapM (\f -> VP.convert <$> VU.mapM (uncurry f) vp))   where     vp = VU.imap (,) $ toUnboxedVector a  prop_smapM_ :: SeedVector -> Array P Ix2 Word -> Property prop_smapM_ seed a =-  withSeed seed (genWithMapM_ (V.sforM_ a)) ===-  withSeed seed (genWithMapM_ (VP.forM_ (toPrimitiveVector a)))+  withSeed seed (genWithMapM_ (V.sforM_ a))+    === withSeed seed (genWithMapM_ (VP.forM_ (toPrimitiveVector a)))  prop_simapM_ :: SeedVector -> Vector U Word -> Property prop_simapM_ seed a =-  withSeed seed (genWithIMapM_ (V.siforM_ a)) ===-  withSeed seed (genWithIMapM_ (\f -> VU.mapM_ (uncurry f) vp))+  withSeed seed (genWithIMapM_ (V.siforM_ a))+    === withSeed seed (genWithIMapM_ (\f -> VU.mapM_ (uncurry f) vp))   where     vp = VU.imap (,) $ toUnboxedVector a  prop_sfilterM :: SeedVector -> Fun Word Bool -> Vector P Word -> Property prop_sfilterM seed g a =   withSeed @(V.Vector DS Word) seed (genWith (`V.sfilterM` a))-  !==! withSeed seed (genWith (`VP.filterM` toPrimitiveVector a))+    !==! withSeed seed (genWith (`VP.filterM` toPrimitiveVector a))   where     genWith :: PrimMonad f => ((Word -> f Bool) -> t) -> MWC.Gen (PrimState f) -> t     genWith genM gen = genM $ \e -> do@@ -312,7 +320,7 @@ prop_sifilterM :: SeedVector -> Fun Word Bool -> Vector U Word -> Property prop_sifilterM seed g a =   withSeed @(V.Vector DS Word) seed (genWith (`V.sifilterM` a))-  !==! withSeed seed (genWith (\f -> VP.convert . VU.map snd <$> VU.filterM (uncurry f) vp))+    !==! withSeed seed (genWith (\f -> VP.convert . VU.map snd <$> VU.filterM (uncurry f) vp))   where     vp = VU.imap (,) $ toUnboxedVector a     genWith :: PrimMonad f => ((Int -> Word -> f Bool) -> t) -> MWC.Gen (PrimState f) -> t@@ -321,8 +329,6 @@       x <- xor ir . xor e <$> uniform gen       pure $ apply g x -- applyFun4 :: Fun (a, b, c, d) e -> (a -> b -> c -> d -> e) applyFun4 (Fun _ f) a b c d = f (a, b, c, d) applyFun5 :: Fun (a, b, c, d, e) f -> (a -> b -> c -> d -> e -> f)@@ -350,7 +356,6 @@ com7M :: Fun (a, b, (c, d, e, h, i)) j -> (j -> k) -> a -> b -> c -> d -> e -> h -> i -> k com7M f g a b c d e h = g . applyFun7 f a b c d e h - prop_szip :: Vector U Word -> Vector U Int -> Property prop_szip v1 v2 = compute (V.szip v1 v2) === toUnboxV2 VU.zip v1 v2 @@ -360,8 +365,8 @@ prop_szip4 :: Vector U Word64 -> Vector U Word32 -> Vector U Word16 -> Vector U Word8 -> Property prop_szip4 v1 v2 v3 v4 = compute (V.szip4 v1 v2 v3 v4) === toUnboxV4 VU.zip4 v1 v2 v3 v4 -prop_szip5 ::-     Vector U Word64+prop_szip5+  :: Vector U Word64   -> Vector U Word32   -> Vector U Word16   -> Vector U Word8@@ -369,8 +374,8 @@   -> Property prop_szip5 v1 v2 v3 v4 v5 = compute (V.szip5 v1 v2 v3 v4 v5) === toUnboxV5 VU.zip5 v1 v2 v3 v4 v5 -prop_szip6 ::-     Vector U Word64+prop_szip6+  :: Vector U Word64   -> Vector U Word32   -> Vector U Word16   -> Vector U Word8@@ -380,13 +385,12 @@ prop_szip6 v1 v2 v3 v4 v5 v6 =   compute (V.szip6 v1 v2 v3 v4 v5 v6) === toUnboxV6 VU.zip6 v1 v2 v3 v4 v5 v6 - prop_szipWith :: Vector P Word -> Vector P Int -> Fun (Word, Int) Int -> Property prop_szipWith v1 v2 f =   V.szipWith (applyFun2 f) v1 v2 !==! toPrimV2 (VP.zipWith (applyFun2 f)) v1 v2 -prop_szipWith3 ::-     Vector P Word64+prop_szipWith3+  :: Vector P Word64   -> Vector P Word32   -> Vector P Word16   -> Fun (Word64, Word32, Word16) Int@@ -394,8 +398,8 @@ prop_szipWith3 v1 v2 v3 f =   V.szipWith3 (applyFun3 f) v1 v2 v3 !==! toPrimV3 (VP.zipWith3 (applyFun3 f)) v1 v2 v3 -prop_szipWith4 ::-     Vector P Word64+prop_szipWith4+  :: Vector P Word64   -> Vector P Word32   -> Vector P Word16   -> Vector P Word8@@ -404,8 +408,8 @@ prop_szipWith4 v1 v2 v3 v4 f =   V.szipWith4 (applyFun4 f) v1 v2 v3 v4 !==! toPrimV4 (VP.zipWith4 (applyFun4 f)) v1 v2 v3 v4 -prop_szipWith5 ::-     Vector P Word64+prop_szipWith5+  :: Vector P Word64   -> Vector P Word32   -> Vector P Word16   -> Vector P Word8@@ -415,8 +419,8 @@ prop_szipWith5 v1 v2 v3 v4 v5 f =   V.szipWith5 (applyFun5 f) v1 v2 v3 v4 v5 !==! toPrimV5 (VP.zipWith5 (applyFun5 f)) v1 v2 v3 v4 v5 -prop_szipWith6 ::-     Vector DS Word64+prop_szipWith6+  :: Vector DS Word64   -> Vector B Word32   -> Vector BN Word16   -> Vector S Word8@@ -425,44 +429,44 @@   -> Fun (Word64, (Word32, Word16, Word8, Int8, Int16)) Int   -> Property prop_szipWith6 v1 v2 v3 v4 v5 v6 f =-  V.szipWith6 (applyFun6 f) v1 v2 v3 v4 v5 v6 !==!-  toPrimV6-    (VP.zipWith6 (applyFun6 f))-    (compute v1)-    (compute v2)-    (compute v3)-    (compute v4)-    (compute v5)-    v6+  V.szipWith6 (applyFun6 f) v1 v2 v3 v4 v5 v6+    !==! toPrimV6+      (VP.zipWith6 (applyFun6 f))+      (compute v1)+      (compute v2)+      (compute v3)+      (compute v4)+      (compute v5)+      v6  prop_sizipWith :: Vector DS Word64 -> Vector DS Word32 -> Fun (Ix1, Word64, Word32) Int -> Property prop_sizipWith v1 v2 f =-  sizipWith (applyFun3 f) v1 v2 !==!-  toPrimV2 (VP.izipWith (applyFun3 f)) (compute v1) (compute v2)+  sizipWith (applyFun3 f) v1 v2+    !==! toPrimV2 (VP.izipWith (applyFun3 f)) (compute v1) (compute v2) -prop_sizipWith3 ::-     Vector P Word64+prop_sizipWith3+  :: Vector P Word64   -> Vector D Word32   -> Vector D Word16   -> Fun (Ix1, Word64, Word32, Word16) Int   -> Property prop_sizipWith3 v1 v2 v3 f =-  sizipWith3 (applyFun4 f) v1 v2 v3 !==!-  toPrimV3 (VP.izipWith3 (applyFun4 f)) (compute v1) (compute v2) (compute v3)+  sizipWith3 (applyFun4 f) v1 v2 v3+    !==! toPrimV3 (VP.izipWith3 (applyFun4 f)) (compute v1) (compute v2) (compute v3) -prop_sizipWith4 ::-     Vector D Word64+prop_sizipWith4+  :: Vector D Word64   -> Vector DS Word32   -> Vector P Word16   -> Vector U Word8   -> Fun (Ix1, Word64, Word32, Word16, Word8) Int   -> Property prop_sizipWith4 v1 v2 v3 v4 f =-  sizipWith4 (applyFun5 f) v1 v2 v3 v4 !==!-  toPrimV4 (VP.izipWith4 (applyFun5 f)) (compute v1) (compute v2) (compute v3) (compute v4)+  sizipWith4 (applyFun5 f) v1 v2 v3 v4+    !==! toPrimV4 (VP.izipWith4 (applyFun5 f)) (compute v1) (compute v2) (compute v3) (compute v4) -prop_sizipWith5 ::-     Vector DS Word64+prop_sizipWith5+  :: Vector DS Word64   -> Vector S Word32   -> Vector P Word16   -> Vector U Word8@@ -470,11 +474,11 @@   -> Fun (Ix1, (Word64, Word32, Word16, Word8, Int8)) Int   -> Property prop_sizipWith5 v1 v2 v3 v4 v5 f =-  sizipWith5 (applyFun6 f) v1 v2 v3 v4 v5 !==!-  toPrimV5 (VP.izipWith5 (applyFun6 f)) (compute v1) (compute v2) v3 (compute v4) (compute v5)+  sizipWith5 (applyFun6 f) v1 v2 v3 v4 v5+    !==! toPrimV5 (VP.izipWith5 (applyFun6 f)) (compute v1) (compute v2) v3 (compute v4) (compute v5) -prop_sizipWith6 ::-     Vector DS Word64+prop_sizipWith6+  :: Vector DS Word64   -> Vector D Word32   -> Vector BL Word16   -> Vector BN Word8@@ -483,31 +487,32 @@   -> Fun (Ix1, Word64, (Word32, Word16, Word8, Int8, Int16)) Int   -> Property prop_sizipWith6 v1 v2 v3 v4 v5 v6 f =-  sizipWith6 (applyFun7 f) v1 v2 v3 v4 v5 v6 !==!-  toPrimV6 (VP.izipWith6 (applyFun7 f)) (compute v1) (compute v2) (compute v3) (compute v4) v5 v6-+  sizipWith6 (applyFun7 f) v1 v2 v3 v4 v5 v6+    !==! toPrimV6 (VP.izipWith6 (applyFun7 f)) (compute v1) (compute v2) (compute v3) (compute v4) v5 v6 -prop_szipWithM ::-     SeedVector -> Vector P Word64 -> Vector P Word32 -> Fun (Word64, Word32) Word -> Property+prop_szipWithM+  :: SeedVector -> Vector P Word64 -> Vector P Word32 -> Fun (Word64, Word32) Word -> Property prop_szipWithM seed v1 v2 f =-  withSeedV2 @DS @Word seed+  withSeedV2 @DS @Word+    seed     (genWithMapM (\g -> V.szipWithM (com2M f g) v1 v2))     (genWithMapM (\g -> toPrimV2 (VP.zipWithM (com2M f g)) v1 v2)) -prop_szipWith3M ::-     SeedVector+prop_szipWith3M+  :: SeedVector   -> Vector P Word64   -> Vector P Word32   -> Vector P Word16   -> Fun (Word64, Word32, Word16) Word   -> Property prop_szipWith3M seed v1 v2 v3 f =-  withSeedV2 @DS @Word seed-  (genWithMapM (\g -> V.szipWith3M (com3M f g) v1 v2 v3))-  (genWithMapM (VP.forM (toPrimV3 (VP.zipWith3 (applyFun3 f)) v1 v2 v3)))+  withSeedV2 @DS @Word+    seed+    (genWithMapM (\g -> V.szipWith3M (com3M f g) v1 v2 v3))+    (genWithMapM (VP.forM (toPrimV3 (VP.zipWith3 (applyFun3 f)) v1 v2 v3))) -prop_szipWith4M ::-     SeedVector+prop_szipWith4M+  :: SeedVector   -> Vector P Word64   -> Vector P Word32   -> Vector P Word16@@ -515,13 +520,13 @@   -> Fun (Word64, Word32, Word16, Word8) Word   -> Property prop_szipWith4M seed v1 v2 v3 v4 f =-  withSeedV2 @DS @Word seed-  (genWithMapM (\g -> V.szipWith4M (com4M f g) v1 v2 v3 v4))-  (genWithMapM (VP.forM (toPrimV4 (VP.zipWith4 (applyFun4 f)) v1 v2 v3 v4)))-+  withSeedV2 @DS @Word+    seed+    (genWithMapM (\g -> V.szipWith4M (com4M f g) v1 v2 v3 v4))+    (genWithMapM (VP.forM (toPrimV4 (VP.zipWith4 (applyFun4 f)) v1 v2 v3 v4))) -prop_szipWith5M ::-     SeedVector+prop_szipWith5M+  :: SeedVector   -> Vector P Word64   -> Vector P Word32   -> Vector P Word16@@ -530,13 +535,13 @@   -> Fun (Word64, Word32, Word16, Word8, Int8) Word   -> Property prop_szipWith5M seed v1 v2 v3 v4 v5 f =-  withSeedV2 @DS @Word seed+  withSeedV2 @DS @Word+    seed     (genWithMapM (\g -> V.szipWith5M (com5M f g) v1 v2 v3 v4 v5))     (genWithMapM (VP.forM (toPrimV5 (VP.zipWith5 (applyFun5 f)) v1 v2 v3 v4 v5))) --prop_szipWith6M ::-     SeedVector+prop_szipWith6M+  :: SeedVector   -> Vector P Int16   -> Vector P Word64   -> Vector P Word32@@ -546,21 +551,21 @@   -> Fun (Int16, (Word64, Word32, Word16, Word8, Int8)) Word   -> Property prop_szipWith6M seed v1 v2 v3 v4 v5 v6 f =-  withSeedV2 @DS @Word seed+  withSeedV2 @DS @Word+    seed     (genWithMapM (\g -> V.szipWith6M (com6M f g) v1 v2 v3 v4 v5 v6))     (genWithMapM (VP.forM (toPrimV6 (VP.zipWith6 (applyFun6 f)) v1 v2 v3 v4 v5 v6))) --prop_szipWithM_ ::-     SeedVector -> Vector P Word64 -> Vector P Word32 -> Fun (Word64, Word32) Word -> Property+prop_szipWithM_+  :: SeedVector -> Vector P Word64 -> Vector P Word32 -> Fun (Word64, Word32) Word -> Property prop_szipWithM_ seed v1 v2 f =   withSeed2     seed     (genWithMapM_ (\g -> V.szipWithM_ (com2M f g) v1 v2))     (genWithMapM_ (\g -> toPrimV2 (VP.zipWithM_ (com2M f g)) v1 v2)) -prop_szipWith3M_ ::-     SeedVector+prop_szipWith3M_+  :: SeedVector   -> Vector P Word64   -> Vector P Word32   -> Vector P Word16@@ -572,8 +577,8 @@     (genWithMapM_ (\g -> V.szipWith3M_ (com3M f g) v1 v2 v3))     (genWithMapM_ (VP.forM_ (toPrimV3 (VP.zipWith3 (applyFun3 f)) v1 v2 v3))) -prop_szipWith4M_ ::-     SeedVector+prop_szipWith4M_+  :: SeedVector   -> Vector P Word64   -> Vector P Word32   -> Vector P Word16@@ -586,9 +591,8 @@     (genWithMapM_ (\g -> V.szipWith4M_ (com4M f g) v1 v2 v3 v4))     (genWithMapM_ (VP.forM_ (toPrimV4 (VP.zipWith4 (applyFun4 f)) v1 v2 v3 v4))) --prop_szipWith5M_ ::-     SeedVector+prop_szipWith5M_+  :: SeedVector   -> Vector P Word64   -> Vector P Word32   -> Vector P Word16@@ -602,8 +606,8 @@     (genWithMapM_ (\g -> V.szipWith5M_ (com5M f g) v1 v2 v3 v4 v5))     (genWithMapM_ (VP.forM_ (toPrimV5 (VP.zipWith5 (applyFun5 f)) v1 v2 v3 v4 v5))) -prop_szipWith6M_ ::-     SeedVector+prop_szipWith6M_+  :: SeedVector   -> Vector P Int16   -> Vector P Word64   -> Vector P Word32@@ -613,32 +617,39 @@   -> Fun (Int16, (Word64, Word32, Word16, Word8, Int8)) Word   -> Property prop_szipWith6M_ seed v1 v2 v3 v4 v5 v6 f =-  withSeed2 seed+  withSeed2+    seed     (genWithMapM_ (\g -> V.szipWith6M_ (com6M f g) v1 v2 v3 v4 v5 v6))     (genWithMapM_ (VP.forM_ (toPrimV6 (VP.zipWith6 (applyFun6 f)) v1 v2 v3 v4 v5 v6))) -prop_sizipWithM ::-     SeedVector -> Vector U Word64 -> Vector U Word32 -> Fun (Ix1, Word64, Word32) Word -> Property+prop_sizipWithM+  :: SeedVector -> Vector U Word64 -> Vector U Word32 -> Fun (Ix1, Word64, Word32) Word -> Property prop_sizipWithM seed v1 v2 f =-  withSeedV2 @DS @Word seed+  withSeedV2 @DS @Word+    seed     (genWithMapM (\g -> V.sizipWithM (com3M f g) v1 v2))-    (genWithMapM (\g -> VP.convert <$>-                        VU.izipWithM (com3M f g) (toUnboxedVector v1) (toUnboxedVector v2)))+    ( genWithMapM+        ( \g ->+            VP.convert+              <$> VU.izipWithM (com3M f g) (toUnboxedVector v1) (toUnboxedVector v2)+        )+    ) -prop_sizipWith3M ::-     SeedVector+prop_sizipWith3M+  :: SeedVector   -> Vector P Word64   -> Vector P Word32   -> Vector P Word16   -> Fun (Ix1, Word64, Word32, Word16) Word   -> Property prop_sizipWith3M seed v1 v2 v3 f =-  withSeedV2 @DS @Word seed-  (genWithMapM (\g -> V.sizipWith3M (com4M f g) v1 v2 v3))-  (genWithMapM (VP.forM (toPrimV3 (VP.izipWith3 (applyFun4 f)) v1 v2 v3)))+  withSeedV2 @DS @Word+    seed+    (genWithMapM (\g -> V.sizipWith3M (com4M f g) v1 v2 v3))+    (genWithMapM (VP.forM (toPrimV3 (VP.izipWith3 (applyFun4 f)) v1 v2 v3))) -prop_sizipWith4M ::-     SeedVector+prop_sizipWith4M+  :: SeedVector   -> Vector P Word64   -> Vector P Word32   -> Vector P Word16@@ -646,12 +657,13 @@   -> Fun (Ix1, Word64, Word32, Word16, Word8) Word   -> Property prop_sizipWith4M seed v1 v2 v3 v4 f =-  withSeedV2 @DS @Word seed-  (genWithMapM (\g -> V.sizipWith4M (com5M f g) v1 v2 v3 v4))-  (genWithMapM (VP.forM (toPrimV4 (VP.izipWith4 (applyFun5 f)) v1 v2 v3 v4)))+  withSeedV2 @DS @Word+    seed+    (genWithMapM (\g -> V.sizipWith4M (com5M f g) v1 v2 v3 v4))+    (genWithMapM (VP.forM (toPrimV4 (VP.izipWith4 (applyFun5 f)) v1 v2 v3 v4))) -prop_sizipWith5M ::-     SeedVector+prop_sizipWith5M+  :: SeedVector   -> Vector P Word64   -> Vector P Word32   -> Vector P Word16@@ -660,13 +672,13 @@   -> Fun (Ix1, (Word64, Word32, Word16, Word8, Int8)) Word   -> Property prop_sizipWith5M seed v1 v2 v3 v4 v5 f =-  withSeedV2 @DS @Word seed+  withSeedV2 @DS @Word+    seed     (genWithMapM (\g -> V.sizipWith5M (com6M f g) v1 v2 v3 v4 v5))     (genWithMapM (VP.forM (toPrimV5 (VP.izipWith5 (applyFun6 f)) v1 v2 v3 v4 v5))) --prop_sizipWith6M ::-     SeedVector+prop_sizipWith6M+  :: SeedVector   -> Vector P Int16   -> Vector P Word64   -> Vector P Word32@@ -676,21 +688,21 @@   -> Fun (Ix1, Int16, (Word64, Word32, Word16, Word8, Int8)) Word   -> Property prop_sizipWith6M seed v1 v2 v3 v4 v5 v6 f =-  withSeedV2 @DS @Word seed+  withSeedV2 @DS @Word+    seed     (genWithMapM (\g -> V.sizipWith6M (com7M f g) v1 v2 v3 v4 v5 v6))     (genWithMapM (VP.forM (toPrimV6 (VP.izipWith6 (applyFun7 f)) v1 v2 v3 v4 v5 v6))) --prop_sizipWithM_ ::-     SeedVector -> Vector U Word64 -> Vector U Word32 -> Fun (Ix1, Word64, Word32) Word -> Property+prop_sizipWithM_+  :: SeedVector -> Vector U Word64 -> Vector U Word32 -> Fun (Ix1, Word64, Word32) Word -> Property prop_sizipWithM_ seed v1 v2 f =   withSeed2     seed     (genWithMapM_ (\g -> V.sizipWithM_ (com3M f g) v1 v2))     (genWithMapM_ (\g -> VU.izipWithM_ (com3M f g) (toUnboxedVector v1) (toUnboxedVector v2))) -prop_sizipWith3M_ ::-     SeedVector+prop_sizipWith3M_+  :: SeedVector   -> Vector P Word64   -> Vector P Word32   -> Vector P Word16@@ -702,8 +714,8 @@     (genWithMapM_ (\g -> V.sizipWith3M_ (com4M f g) v1 v2 v3))     (genWithMapM_ (VP.forM_ (toPrimV3 (VP.izipWith3 (applyFun4 f)) v1 v2 v3))) -prop_sizipWith4M_ ::-     SeedVector+prop_sizipWith4M_+  :: SeedVector   -> Vector P Word64   -> Vector P Word32   -> Vector P Word16@@ -716,9 +728,8 @@     (genWithMapM_ (\g -> V.sizipWith4M_ (com5M f g) v1 v2 v3 v4))     (genWithMapM_ (VP.forM_ (toPrimV4 (VP.izipWith4 (applyFun5 f)) v1 v2 v3 v4))) --prop_sizipWith5M_ ::-     SeedVector+prop_sizipWith5M_+  :: SeedVector   -> Vector P Word64   -> Vector P Word32   -> Vector P Word16@@ -732,9 +743,8 @@     (genWithMapM_ (\g -> V.sizipWith5M_ (com6M f g) v1 v2 v3 v4 v5))     (genWithMapM_ (VP.forM_ (toPrimV5 (VP.izipWith5 (applyFun6 f)) v1 v2 v3 v4 v5))) --prop_sizipWith6M_ ::-     SeedVector+prop_sizipWith6M_+  :: SeedVector   -> Vector P Int16   -> Vector P Word64   -> Vector P Word32@@ -744,7 +754,8 @@   -> Fun (Ix1, Int16, (Word64, Word32, Word16, Word8, Int8)) Word   -> Property prop_sizipWith6M_ seed v1 v2 v3 v4 v5 v6 f =-  withSeed2 seed+  withSeed2+    seed     (genWithMapM_ (\g -> V.sizipWith6M_ (com7M f g) v1 v2 v3 v4 v5 v6))     (genWithMapM_ (VP.forM_ (toPrimV6 (VP.izipWith6 (applyFun7 f)) v1 v2 v3 v4 v5 v6))) @@ -789,28 +800,28 @@           prop "head' (non-empty)" $ \(ArrNE arr :: ArrNE D Ix1 Int) ->             head' arr === evaluate' arr 0 .&&. head' arr === shead' arr           prop "head'" $ \(arr :: Array D Ix1 Int) ->-            (singleton (head' arr) :: Array D Ix1 Int) !!==!!-            VP.singleton (VP.head (toPrimitiveVector (compute arr)))+            (singleton (head' arr) :: Array D Ix1 Int)+              !!==!! VP.singleton (VP.head (toPrimitiveVector (compute arr)))           prop "shead'" $ \(arr :: Array P Ix1 Int) ->-            (singleton (shead' arr) :: Array D Ix1 Int) !!==!!-            VP.singleton (VP.head (toPrimitiveVector arr))+            (singleton (shead' arr) :: Array D Ix1 Int)+              !!==!! VP.singleton (VP.head (toPrimitiveVector arr))           prop "last'" $ \(arr :: Array P Ix1 Int) ->-            (singleton (last' arr) :: Array D Ix1 Int) !!==!!-            VP.singleton (VP.last (toPrimitiveVector arr))+            (singleton (last' arr) :: Array D Ix1 Int)+              !!==!! VP.singleton (VP.last (toPrimitiveVector arr))           prop "unconsM" $ \(v :: Vector D Int) ->-            fmap (computeAs P <$>) (A.unconsM v :: Maybe (Int, Vector D Int)) ===-            fmap (fmap (A.fromList Seq)) (List.uncons (A.toList v))+            fmap (computeAs P <$>) (A.unconsM v :: Maybe (Int, Vector D Int))+              === fmap (fmap (A.fromList Seq)) (List.uncons (A.toList v))           prop "unsnocM" $ \(v :: Vector D Int) ->-            fmap (first (computeAs P)) (A.unsnocM v :: Maybe (Vector D Int, Int)) ===-            fmap-              (Tuple.swap . fmap (A.fromList Seq . List.reverse))-              (List.uncons (A.toList (A.reverse Dim1 v)))+            fmap (first (computeAs P)) (A.unsnocM v :: Maybe (Vector D Int, Int))+              === fmap+                (Tuple.swap . fmap (A.fromList Seq . List.reverse))+                (List.uncons (A.toList (A.reverse Dim1 v)))         describe "Slicing" $ do           prop "slice" $ \i sz (arr :: Array P Ix1 Word) ->             V.slice i sz arr !!==!! VP.take (unSz sz) (VP.drop i (toPrimitiveVector arr))           prop "sslice" $ \i sz (arr :: Array P Ix1 Word) ->-            computeAs B (V.sslice i sz arr) !!==!!-            VP.take (unSz sz) (VP.drop i (toPrimitiveVector arr))+            computeAs B (V.sslice i sz arr)+              !!==!! VP.take (unSz sz) (VP.drop i (toPrimitiveVector arr))           prop "slice'" $ \i sz (arr :: Array P Ix1 Word) ->             V.slice' i sz arr !!==!! VP.slice i (unSz sz) (toPrimitiveVector arr)           prop "init" $ \(arr :: Array P Ix1 Word) ->@@ -819,8 +830,8 @@             V.init' arr !!==!! VP.init (toPrimitiveVector arr)           prop "tail" $ \(arr :: Array P Ix1 Word) ->             let vp = toPrimitiveVector arr-             in (V.tail arr !==! VP.drop 1 vp) .&&.-                (not (isEmpty arr) ==> V.tail arr !==! VP.tail vp)+             in (V.tail arr !==! VP.drop 1 vp)+                  .&&. (not (isEmpty arr) ==> V.tail arr !==! VP.tail vp)           prop "tail'" $ \(arr :: Array P Ix1 Word) ->             V.tail' arr !!==!! VP.tail (toPrimitiveVector arr)           prop "take" $ \n (arr :: Array P Ix1 Word) ->@@ -867,8 +878,8 @@           prop "siterateN" $ \n (f :: Fun Word Word) a ->             V.siterateN (Sz n) (apply f) a !==! VP.iterateN n (apply f) a           prop "siterate" $ \n (f :: Fun Word Word) a ->-            computeAs P (V.stake n (V.siterate (apply f) a)) ===-            computeAs P (V.siterateN n (apply f) a)+            computeAs P (V.stake n (V.siterate (apply f) a))+              === computeAs P (V.siterateN n (apply f) a)           prop "cons" $ \e (v :: Vector P Word) ->             computeAs P (V.cons e (toLoadArray v)) !!==!! VP.cons e (toPrimitiveVector v)         describe "Monadic initialization" $ do@@ -885,8 +896,8 @@             let f b                   | b > 10000 || b `div` 19 == 0 = Nothing                   | otherwise = Just (b * b, b + 1)-             in V.sunfoldrN (Sz n) f a !==! VP.unfoldrN n f a .&&. A.unsafeUnfoldrN (Sz n) f a !==!-                VP.unfoldrN n f a+             in (V.sunfoldrN (Sz n) f a !==! VP.unfoldrN n f a)+                  .&&. (A.unsafeUnfoldrN (Sz n) f a !==! VP.unfoldrN n f a)           it "sunfoldrN (maxBound)" $             let maxv = V.sunfoldrN (Sz maxBound) (const (Nothing :: Maybe (Word8, Word8))) 0              in computeAs P maxv `shouldBe` A.empty@@ -957,8 +968,8 @@           prop "sizipWith5" prop_sizipWith5           prop "sizipWith6" prop_sizipWith6           prop "liftA2" $ \(v1 :: Vector DS Word) (v2 :: Vector DS Int) (f :: Fun (Word, Int) Int) ->-            liftA2 (applyFun2 f) v1 v2 !==!-            toPrimV2 (VP.zipWith (applyFun2 f)) (compute v1) (compute v2)+            liftA2 (applyFun2 f) v1 v2+              !==! toPrimV2 (VP.zipWith (applyFun2 f)) (compute v1) (compute v2)           prop "szipWithM" prop_szipWithM           prop "szipWith3M" prop_szipWith3M           prop "szipWith4M" prop_szipWith4M@@ -1009,11 +1020,26 @@             sfromListN (Sz (maxBound `div` 8)) xs !==! VP.fromList xs           prop "unsafeFromListN" $ \sz@(Sz n) (xs :: [Word]) ->             A.unsafeFromListN sz xs !==! VP.fromListN n xs+      describe "Scanning" $ do+        prop "sscanl" $ \(v :: Vector P Word32) (f :: Fun (Word, Word32) Word) a0 ->+          V.sscanl (applyFun2 f) a0 v !==! VP.scanl' (applyFun2 f) a0 (toPrimitiveVector v)+        prop "sscanl1" $ \(v :: Vector P Word32) (f :: Fun (Word32, Word32) Word32) ->+          isNotEmpty v+            ==> (V.sscanl1 (applyFun2 f) v !==! VP.scanl1' (applyFun2 f) (toPrimitiveVector v))+        prop "sprescanl" $ \(v :: Vector P Word32) (f :: Fun (Word, Word32) Word) a0 ->+          V.sprescanl (applyFun2 f) a0 v+            !==! VP.prescanl' (applyFun2 f) a0 (toPrimitiveVector v)+        prop "spostscanl" $ \(v :: Vector P Word32) (f :: Fun (Word, Word32) Word) a0 ->+          V.spostscanl (applyFun2 f) a0 v+            !==! VP.postscanl' (applyFun2 f) a0 (toPrimitiveVector v)+        prop "spostscanlAcc" $ \(v :: Vector P Word32) (f :: Fun (Word, Word32) Word) a0 ->+          V.spostscanlAcc (\x y -> let z = applyFun2 f x y in (z, z)) a0 v+            !==! VP.postscanl' (applyFun2 f) a0 (toPrimitiveVector v)  prop_sfoldl1' :: Vector P Word -> Fun (Word, Word) Word -> Property prop_sfoldl1' v f =-  V.singleton @D (V.sfoldl1' (applyFun2 f) v) !!==!!-  VP.singleton (VP.foldl1' (applyFun2 f) (toPrimitiveVector v))+  V.singleton @D (V.sfoldl1' (applyFun2 f) v)+    !!==!! VP.singleton (VP.foldl1' (applyFun2 f) (toPrimitiveVector v))  prop_maximum' :: Vector P Word -> Property prop_maximum' v =@@ -1035,21 +1061,24 @@  prop_sitraverse_itraverseA :: SeedVector -> Vector S Word -> Property prop_sitraverse_itraverseA seed a =-  withSeed2 @(V.Vector P Word) seed-  (fmap compute . genWithIMapM (`V.sitraverse` a))-  (genWithIMapM (`itraverseA` a))+  withSeed2 @(V.Vector P Word)+    seed+    (fmap compute . genWithIMapM (`V.sitraverse` a))+    (genWithIMapM (`itraverseA` a))  prop_straverse_traversePrim :: SeedVector -> Vector S Word -> Property prop_straverse_traversePrim seed a =-  withSeed2 @(V.Vector P Word) seed-  (fmap compute . genWithIMapM (\f -> V.straverse (f 0) a))-  (genWithIMapM (\f -> traversePrim (f 0) a))+  withSeed2 @(V.Vector P Word)+    seed+    (fmap compute . genWithIMapM (\f -> V.straverse (f 0) a))+    (genWithIMapM (\f -> traversePrim (f 0) a))  prop_sitraverse_itraversePrim :: SeedVector -> Array P Ix3 Word -> Property prop_sitraverse_itraversePrim seed a =-  withSeed2 @(V.Vector P Word) seed-  (genWithIMapM (\f -> compute <$> V.sitraverse (xorToLinear f) a))-  (genWithIMapM (\f -> flatten <$> itraversePrim @P (xorToLinear f) a))+  withSeed2 @(V.Vector P Word)+    seed+    (genWithIMapM (\f -> compute <$> V.sitraverse (xorToLinear f) a))+    (genWithIMapM (\f -> flatten <$> itraversePrim @P (xorToLinear f) a))   where     xorToLinear f i = f (foldlIndex xor 0 i) @@ -1066,62 +1095,61 @@   where     xorToLinear f i = f (foldlIndex xor 0 i) -prop_sforM_forM :: SeedVector -> Vector S Word -> Property+prop_sforM_forM :: SeedVector -> Vector S Word -> Expectation prop_sforM_forM seed a =   withSeed @(V.Vector P Word) seed (fmap compute . genWithMapM (V.sforM a))-  === withSeed seed (genWithMapM (A.forM a))+    `shouldBe` withSeed seed (genWithMapM (A.forM a)) -prop_siforM_iforM :: SeedVector -> Vector S Word -> Property+prop_siforM_iforM :: SeedVector -> Vector S Word -> Expectation prop_siforM_iforM seed a =   withSeed @(V.Vector P Word) seed (fmap compute . genWithIMapM (V.siforM a))-  === withSeed seed (genWithIMapM (iforM a))+    `shouldBe` withSeed seed (genWithIMapM (iforM a))  withSeedIO :: forall a. SeedVector -> (MWC.Gen (PrimState IO) -> IO a) -> IO a withSeedIO (SeedVector seed) f = MWC.initialize seed >>= f -prop_sforM_forIO :: SeedVector -> Vector S Word -> Property-prop_sforM_forIO seed a = property $-  withSeedIO seed (genWithMapM (forIO (setComp Seq a))) `shouldReturn`-    withSeed @(V.Vector P Word) seed (fmap compute . genWithMapM (V.sforM a))--prop_siforM_iforIO :: SeedVector -> Vector S Word -> Property-prop_siforM_iforIO seed a = property $-  withSeedIO seed (genWithIMapM (iforIO (setComp (ParN 1) a))) `shouldReturn`-    withSeed @(V.Vector P Word) seed (fmap compute . genWithIMapM (V.siforM a))+prop_sforM_forIO :: SeedVector -> Vector S Word -> Expectation+prop_sforM_forIO seed a =+  withSeedIO seed (genWithMapM (forIO (setComp Seq a)))+    `shouldReturn` withSeed @(V.Vector P Word) seed (fmap compute . genWithMapM (V.sforM a)) -prop_sforM_forM_ :: SeedVector -> Vector S Word -> Property-prop_sforM_forM_ seed a = property $-  withSeed seed (genWithMapM_ (A.forM_ a)) `shouldBe`-    withSeed @Word seed (genWithMapM_ (V.sforM_ a))+prop_siforM_iforIO :: SeedVector -> Vector S Word -> Expectation+prop_siforM_iforIO seed a =+  withSeedIO seed (genWithIMapM (iforIO (setComp (ParN 1) a)))+    `shouldReturn` withSeed @(V.Vector P Word) seed (fmap compute . genWithIMapM (V.siforM a)) -prop_siforM_iforM_ :: SeedVector -> Vector S Word -> Property-prop_siforM_iforM_ seed a = property $-  withSeed seed (genWithIMapM_ (iforM_ a)) `shouldBe`-    withSeed @Word seed (genWithIMapM_ (V.siforM_ a))+prop_sforM_forM_ :: SeedVector -> Vector S Word -> Expectation+prop_sforM_forM_ seed a =+  withSeed seed (genWithMapM_ (A.forM_ a))+    `shouldBe` withSeed @Word seed (genWithMapM_ (V.sforM_ a)) -prop_sforM_forIO_ :: SeedVector -> Vector S Word -> Property-prop_sforM_forIO_ seed a = property $-  withSeedIO seed (genWithMapM_ (forIO_ (setComp (ParN 1) a))) `shouldReturn`-    withSeed @Word seed (genWithMapM_ (V.sforM_ a))+prop_siforM_iforM_ :: SeedVector -> Vector S Word -> Expectation+prop_siforM_iforM_ seed a =+  withSeed seed (genWithIMapM_ (iforM_ a))+    `shouldBe` withSeed @Word seed (genWithIMapM_ (V.siforM_ a)) -prop_siforM_iforIO_ :: SeedVector -> Vector S Word -> Property-prop_siforM_iforIO_ seed a = property $-  withSeedIO seed (genWithIMapM_ (iforIO_ (setComp (ParN 1) a))) `shouldReturn`-    withSeed @Word seed (genWithIMapM_ (V.siforM_ a))+prop_sforM_forIO_ :: SeedVector -> Vector S Word -> Expectation+prop_sforM_forIO_ seed a =+  withSeedIO seed (genWithMapM_ (forIO_ (setComp (ParN 1) a)))+    `shouldReturn` withSeed @Word seed (genWithMapM_ (V.sforM_ a)) +prop_siforM_iforIO_ :: SeedVector -> Vector S Word -> Expectation+prop_siforM_iforIO_ seed a =+  withSeedIO seed (genWithIMapM_ (iforIO_ (setComp (ParN 1) a)))+    `shouldReturn` withSeed @Word seed (genWithIMapM_ (V.siforM_ a)) -prop_siforM_iforWS :: SeedVector -> Vector S Word -> Property-prop_siforM_iforWS seed@(SeedVector sv) a =-  property $ do-    wsArray <--      do ws <- initWorkerStates (ParN 1) (const (MWC.initialize sv))-         genWithIMapWS (iforWS ws a)-    wsArray `shouldBe` withSeed @(V.Vector P Word) seed (fmap compute . genWithIMapM (V.siforM a))+prop_siforM_iforWS :: SeedVector -> Vector S Word -> Expectation+prop_siforM_iforWS seed@(SeedVector sv) a = do+  wsArray <-+    do+      ws <- initWorkerStates (ParN 1) (const (MWC.initialize sv))+      genWithIMapWS (iforWS ws a)+  wsArray `shouldBe` withSeed @(V.Vector P Word) seed (fmap compute . genWithIMapM (V.siforM a)) -prop_smapM_mapWS :: SeedVector -> Vector S Word -> Property-prop_smapM_mapWS seed@(SeedVector sv) a =-  property $ do-    wsArray <--      do ws <- initWorkerStates Seq (const (MWC.initialize sv))-         genWithMapWS (\f -> mapWS ws f a)-    wsArray `shouldBe` withSeed @(V.Vector P Word) seed (fmap compute . genWithMapM (`V.smapM` a))+prop_smapM_mapWS :: SeedVector -> Vector S Word -> Expectation+prop_smapM_mapWS seed@(SeedVector sv) a = do+  wsArray <-+    do+      ws <- initWorkerStates Seq (const (MWC.initialize sv))+      genWithMapWS (\f -> mapWS ws f a)+  wsArray `shouldBe` withSeed @(V.Vector P Word) seed (fmap compute . genWithMapM (`V.smapM` a))