From ebfab25c6be5e295293971345fbbc83dee0507f7 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Wed, 25 Nov 2020 07:32:31 +0300 Subject: [PATCH 01/65] Improve speed of matrix multiplication by implementing a more cache friendly iteration Finish Matrix X Matrix multiplication: 20% speedup --- massiv/src/Data/Massiv/Array/Numeric.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/massiv/src/Data/Massiv/Array/Numeric.hs b/massiv/src/Data/Massiv/Array/Numeric.hs index 29451643..50594efd 100644 --- a/massiv/src/Data/Massiv/Array/Numeric.hs +++ b/massiv/src/Data/Massiv/Array/Numeric.hs @@ -712,7 +712,6 @@ multiplyMatricesTransposed arr1 arr2 {-# INLINE multiplyMatricesTransposed #-} - -- | Create an indentity matrix. -- -- ==== __Example__ From f8b582b5cdf9b338fd408b59d98c450d14a6eaa9 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sat, 28 Nov 2020 05:09:23 +0300 Subject: [PATCH 02/65] Redesign DL and other loaders to have access to efficient setting function: * Improve loading of push arrays by adding `loadArrayWithSetM` and deprecating `defaultElement` * Export `Scheduler` and `SchedulerWS` from `Core` * Add concat benchmarks --- massiv/CHANGELOG.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/massiv/CHANGELOG.md b/massiv/CHANGELOG.md index 20e496c5..8931d734 100644 --- a/massiv/CHANGELOG.md +++ b/massiv/CHANGELOG.md @@ -54,6 +54,10 @@ * Improve loading of push arrays by adding `loadArrayWithSetM` and deprecating `defaultElement`. +# 0.5.8 + +* Improve loading of push arrays by adding `loadArrayWithSetM` and deprecating `defaultElement`. + # 0.5.7 * Improve performance of `><.` and `> Date: Tue, 8 Dec 2020 03:02:45 +0300 Subject: [PATCH 03/65] Update changelog --- massiv/CHANGELOG.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/massiv/CHANGELOG.md b/massiv/CHANGELOG.md index 8931d734..0645a4f0 100644 --- a/massiv/CHANGELOG.md +++ b/massiv/CHANGELOG.md @@ -54,6 +54,10 @@ * Improve loading of push arrays by adding `loadArrayWithSetM` and deprecating `defaultElement`. +# 0.5.9 + +* Add `mallocCompute`, `mallocCopy` and `unsafeMallocMArray` + # 0.5.8 * Improve loading of push arrays by adding `loadArrayWithSetM` and deprecating `defaultElement`. From 53e55328119dd49fb3c1e96066688eae4387ff8c Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Mon, 18 Jan 2021 05:09:41 +0300 Subject: [PATCH 04/65] Improve mutable array initialization: * Make `replicate` a function in `Construct` class * Add `newMArray`, `newMArray'` and deprecate `new` * Add custom implementation for `<$` in `Functor` instances for `BL` and `B`. --- massiv/src/Data/Massiv/Array/Mutable.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/massiv/src/Data/Massiv/Array/Mutable.hs b/massiv/src/Data/Massiv/Array/Mutable.hs index 273de622..a102b8e3 100644 --- a/massiv/src/Data/Massiv/Array/Mutable.hs +++ b/massiv/src/Data/Massiv/Array/Mutable.hs @@ -127,8 +127,8 @@ new = initializeNew Nothing -- | /O(n)/ - Initialize a new mutable array. All elements will be set to some default value. For --- boxed arrays in will be a thunk with `Uninitialized` exception, while for others it will be --- simply zeros. This is a partial function. +-- boxed arrays it will be a thunk with `Uninitialized` exception, while for others it will be +-- simply zeros. -- -- ==== __Examples__ -- From 7f451b39d7af381674db253b6031c51fd8c0dfbf Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sat, 28 Nov 2020 05:09:23 +0300 Subject: [PATCH 05/65] Redesign DL and other loaders to have access to efficient setting function: * Improve loading of push arrays by adding `loadArrayWithSetM` and deprecating `defaultElement` * Export `Scheduler` and `SchedulerWS` from `Core` * Add concat benchmarks --- massiv-bench/src/Data/Massiv/Bench/Vector.hs | 1 + massiv/src/Data/Massiv/Core/Common.hs | 1 - 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/massiv-bench/src/Data/Massiv/Bench/Vector.hs b/massiv-bench/src/Data/Massiv/Bench/Vector.hs index be88ad50..c374e13c 100644 --- a/massiv-bench/src/Data/Massiv/Bench/Vector.hs +++ b/massiv-bench/src/Data/Massiv/Bench/Vector.hs @@ -17,6 +17,7 @@ import Control.DeepSeq import Criterion.Main import Data.Massiv.Array import Data.Massiv.Bench.Common +import Data.Massiv.Bench.Matrix import Data.Typeable import System.Random diff --git a/massiv/src/Data/Massiv/Core/Common.hs b/massiv/src/Data/Massiv/Core/Common.hs index b773777c..5409a189 100644 --- a/massiv/src/Data/Massiv/Core/Common.hs +++ b/massiv/src/Data/Massiv/Core/Common.hs @@ -371,7 +371,6 @@ class (Typeable r, Index ix) => Load r ix e where pure marr {-# INLINE unsafeLoadIntoM #-} - -- | Selects an optimal scheduler for the supplied strategy, but it works only in `IO` withMassivScheduler_ :: Comp -> (Scheduler IO () -> IO ()) -> IO () withMassivScheduler_ comp f = From 32d4c039254e09eb6740af85a658e7d621b02ad5 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Tue, 3 Nov 2020 14:53:36 +0300 Subject: [PATCH 06/65] Restructure of classes hierarchy and removal of is parameter: * Introduce `Shape`, the parent of `Size` * Move `size` from `Load` into new class `Size` * Removed `maxSize` and replaced it with `maxLinearSize` * Remove specialized `DW` instances that used tuples as indices. * Remove `OuterSlice L` instance * Add `Strategy` and move `setComp` (from `Construct`) and `getComp` (from `Load`) in there. * Remove `ix` from `Mutable` * Remove `ix` from `Manifest` * Remove `ix` from `Source` * Remove `ix` from `Resize` * Prevent `showsArrayPrec` from changing index type * Remove all deprecated functions: * `|*|`, `#>` --- massiv-test/src/Test/Massiv/Array/Delayed.hs | 6 +- massiv-test/src/Test/Massiv/Array/Mutable.hs | 37 +- massiv-test/src/Test/Massiv/Array/Numeric.hs | 70 ++-- massiv-test/src/Test/Massiv/Core/Common.hs | 2 +- massiv-test/src/Test/Massiv/Core/Mutable.hs | 52 +-- .../Massiv/Array/Delayed/InterleavedSpec.hs | 5 +- .../Test/Massiv/Array/Delayed/WindowedSpec.hs | 3 - .../tests/Test/Massiv/Array/DelayedSpec.hs | 2 +- .../Test/Massiv/Array/Manifest/VectorSpec.hs | 9 +- .../tests/Test/Massiv/Array/ManifestSpec.hs | 4 +- .../tests/Test/Massiv/Array/MutableSpec.hs | 25 +- .../tests/Test/Massiv/Array/Ops/FoldSpec.hs | 3 +- .../tests/Test/Massiv/Array/Ops/MapSpec.hs | 6 +- .../Test/Massiv/Array/Ops/TransformSpec.hs | 34 +- .../tests/Test/Massiv/Array/StencilSpec.hs | 110 +++--- massiv-test/tests/Test/Massiv/ArraySpec.hs | 8 +- massiv-test/tests/Test/Massiv/VectorSpec.hs | 7 +- massiv/CHANGELOG.md | 16 + .../Data/Massiv/Array/Delayed/Interleaved.hs | 23 +- massiv/src/Data/Massiv/Array/Delayed/Pull.hs | 34 +- massiv/src/Data/Massiv/Array/Delayed/Push.hs | 26 +- .../src/Data/Massiv/Array/Delayed/Stream.hs | 48 +-- .../src/Data/Massiv/Array/Delayed/Windowed.hs | 107 +----- massiv/src/Data/Massiv/Array/Manifest.hs | 6 +- .../src/Data/Massiv/Array/Manifest/Boxed.hs | 105 +++-- .../Data/Massiv/Array/Manifest/Internal.hs | 66 ++-- massiv/src/Data/Massiv/Array/Manifest/List.hs | 21 +- .../Data/Massiv/Array/Manifest/Primitive.hs | 27 +- .../Data/Massiv/Array/Manifest/Storable.hs | 29 +- .../src/Data/Massiv/Array/Manifest/Unboxed.hs | 27 +- .../src/Data/Massiv/Array/Manifest/Vector.hs | 18 +- massiv/src/Data/Massiv/Array/Mutable.hs | 158 ++++---- .../Data/Massiv/Array/Mutable/Algorithms.hs | 8 +- .../src/Data/Massiv/Array/Mutable/Internal.hs | 6 +- massiv/src/Data/Massiv/Array/Numeric.hs | 86 ++--- .../src/Data/Massiv/Array/Numeric/Integral.hs | 10 +- massiv/src/Data/Massiv/Array/Ops/Construct.hs | 22 +- massiv/src/Data/Massiv/Array/Ops/Fold.hs | 58 +-- .../Data/Massiv/Array/Ops/Fold/Internal.hs | 117 +++--- massiv/src/Data/Massiv/Array/Ops/Map.hs | 111 +++--- massiv/src/Data/Massiv/Array/Ops/Sort.hs | 46 +-- massiv/src/Data/Massiv/Array/Ops/Transform.hs | 89 +++-- massiv/src/Data/Massiv/Array/Stencil.hs | 4 +- .../Data/Massiv/Array/Stencil/Convolution.hs | 4 +- .../src/Data/Massiv/Array/Stencil/Unsafe.hs | 34 -- massiv/src/Data/Massiv/Array/Unsafe.hs | 6 +- massiv/src/Data/Massiv/Core.hs | 2 +- massiv/src/Data/Massiv/Core/Common.hs | 361 +++++++++++------- massiv/src/Data/Massiv/Core/List.hs | 256 +++++++++---- massiv/src/Data/Massiv/Core/Operations.hs | 15 +- massiv/src/Data/Massiv/Vector.hs | 254 +++--------- massiv/src/Data/Massiv/Vector/Stream.hs | 268 ++++++++----- massiv/src/Data/Massiv/Vector/Unsafe.hs | 24 +- 53 files changed, 1513 insertions(+), 1362 deletions(-) diff --git a/massiv-test/src/Test/Massiv/Array/Delayed.hs b/massiv-test/src/Test/Massiv/Array/Delayed.hs index ded0c9c8..f9a4ff0e 100644 --- a/massiv-test/src/Test/Massiv/Array/Delayed.hs +++ b/massiv-test/src/Test/Massiv/Array/Delayed.hs @@ -32,7 +32,7 @@ import Data.List as L -- | Alternative implementation of `stackSlicesM` with `concat'`. Useful for testing and benchmarks stackSlices' :: - (Functor f, Foldable f, Resize r (Lower ix), Source r ix e, Load r (Lower ix) e) + (Functor f, Foldable f, Resize r, Source r e, Index ix, Load r (Lower ix) e) => Dim -> f (Array r (Lower ix) e) -> Array DL ix e @@ -48,7 +48,7 @@ compareAsListAndLoaded str ls = -- | Compare `toStream` and `A.toList` prop_toStream :: - forall r ix e. (Source r ix e, Stream r ix e, Show e, Eq e) + forall r ix e. (Source r e, Stream r ix e, Show e, Eq e) => Array r ix e -> Property prop_toStream arr = @@ -132,7 +132,7 @@ prop_takeDrop :: forall r e. ( Eq e , Show e - , Source r Ix1 e + , Source r e , Foldable (Array r Ix1) ) => Vector r e diff --git a/massiv-test/src/Test/Massiv/Array/Mutable.hs b/massiv-test/src/Test/Massiv/Array/Mutable.hs index c52a129c..37717299 100644 --- a/massiv-test/src/Test/Massiv/Array/Mutable.hs +++ b/massiv-test/src/Test/Massiv/Array/Mutable.hs @@ -31,13 +31,13 @@ import Test.Massiv.Utils as T import UnliftIO.Async --- prop_MapMapM :: forall r ix(Show (Array r ix Word), Eq (Array r ix Word), Mutable r ix Word) => +-- prop_MapMapM :: forall r ix(Show (Array r ix Word), Eq (Array r ix Word), Mutable 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), Mutable r ix e) + forall r ix e. (Show (Array r ix e), Eq (Array r ix e), Mutable r e, Index ix) => Fun (ix, e) e -> Array D ix e -> Property @@ -49,7 +49,8 @@ prop_GenerateArray :: forall r ix e. ( Show (Array r ix e) , Eq (Array r ix e) - , Mutable r ix e + , Mutable r e + , Construct r ix e , Show e , Arbitrary e , Arbitrary ix @@ -68,13 +69,7 @@ prop_GenerateArray = prop_Shrink :: forall r ix e. - ( Show (Array r ix e) - , Mutable r ix e - , Source r Ix1 e - , Arbitrary ix - , Arbitrary e - , Eq e - ) + (Show (Array r ix e), Mutable r e, Construct r ix e, Arbitrary ix, Arbitrary e, Eq e) => Property prop_Shrink = property $ \ (ArrIx arr ix) -> runST $ do @@ -88,8 +83,9 @@ prop_GrowShrink :: ( Eq (Array r ix e) , Show (Array r ix e) , Load (R r) ix e - , Mutable r ix e + , Mutable r e , Extract r ix e + , Construct r ix e , Arbitrary ix , Arbitrary e , Show e @@ -115,12 +111,11 @@ prop_unfoldrList :: forall r ix e. ( Show (Array r Ix1 e) , Eq (Array r Ix1 e) + , Index ix , Arbitrary ix , Arbitrary e , Show e - , Resize r ix - , Mutable r ix e - , Mutable r Ix1 e + , Mutable r e ) => Property prop_unfoldrList = @@ -134,11 +129,11 @@ prop_unfoldrReverseUnfoldl :: forall r ix e. ( Show (Array r ix e) , Eq (Array r ix e) + , Index ix , Arbitrary ix , Arbitrary e , Show e - , Source r ix e - , Mutable r ix e + , Mutable r e ) => Property prop_unfoldrReverseUnfoldl = @@ -151,12 +146,14 @@ prop_unfoldrReverseUnfoldl = rev a1 `shouldBe` a2 prop_toStreamArrayMutable :: - (Mutable r ix e, Show (Array r ix e), Eq (Array r ix e)) => Array r ix e -> Property + forall r ix e. (Mutable r e, Index ix, Show (Array r ix e), Eq (Array r ix e)) + => Array r ix e + -> Property prop_toStreamArrayMutable arr = arr === S.unstreamExact (size arr) (S.stepsStream (toSteps (toStreamArray arr))) prop_WithMArray :: - forall r ix e. (HasCallStack, Mutable r ix e, Eq (Array r ix e), Show (Array r ix e)) + forall r ix e. (HasCallStack, Index ix, Mutable r e, Eq (Array r ix e), Show (Array r ix e)) => Array r ix e -> Fun e e -> Fun e e @@ -193,9 +190,9 @@ mutableSpec :: , Typeable e , Show e , Eq e - , Mutable r ix e - , Mutable r Ix1 e + , Mutable r e , Extract r ix e + , Construct r ix e , CoArbitrary ix , Arbitrary e , CoArbitrary e diff --git a/massiv-test/src/Test/Massiv/Array/Numeric.hs b/massiv-test/src/Test/Massiv/Array/Numeric.hs index 0f21515d..aa7c0afc 100644 --- a/massiv-test/src/Test/Massiv/Array/Numeric.hs +++ b/massiv-test/src/Test/Massiv/Array/Numeric.hs @@ -18,7 +18,7 @@ import Test.Massiv.Core.Common () naiveMatrixMatrixMultiply :: - (Num e, Source (R r1) Ix1 e, Source (R r2) Ix1 e, OuterSlice r1 Ix2 e, InnerSlice r2 Ix2 e) + (Num e, Source (R r1) e, Source (R r2) e, OuterSlice r1 Ix2 e, InnerSlice r2 Ix2 e) => Array r1 Ix2 e -> Array r2 Ix2 e -> Array D Ix2 e @@ -38,7 +38,7 @@ naiveMatrixMatrixMultiply arr1 arr2 prop_MatrixMatrixMultiply :: - forall r e. (Numeric r e, Mutable r Ix2 e, Eq (Matrix r e), Show (Matrix r e)) + forall r e. (Numeric r e, Mutable r e, Eq (Matrix r e), Show (Matrix r e)) => Fun e e -> Matrix r e -> Property @@ -55,9 +55,8 @@ prop_MatrixVectorMultiply :: forall r e. ( Numeric r e , InnerSlice r Ix2 e - , Mutable r Ix2 e - , Source (R r) Ix1 e - , Source r Ix1 e + , Mutable r e + , Source (R r) e , Construct r Ix1 e , Eq e , Show e @@ -77,9 +76,9 @@ prop_VectorMatrixMultiply :: forall r e. ( Numeric r e , OuterSlice r Ix2 e - , Mutable r Ix2 e - , Source (R r) Ix1 e - , Mutable r Ix1 e + , Construct r Ix1 e + , Source (R r) e + , Mutable r e , Show (Vector r e) , Eq (Vector r e) ) @@ -97,7 +96,7 @@ prop_VectorMatrixMultiply f arr = (== SizeMismatchException (Sz2 1 (m + 1)) (size arr)) prop_DotProduct :: - forall r e. (Numeric r e, Mutable r Ix1 e, Eq e, Show e) + forall r e. (Numeric r e, Mutable r e, Eq e, Show e, Construct r Ix1 e) => Fun e e -> Vector r e -> Property @@ -109,7 +108,7 @@ prop_DotProduct f v = (== SizeMismatchException (size v) (size v + 1)) prop_Norm :: - forall r e. (NumericFloat r e, Mutable r Ix1 e, RealFloat e, Show e) + forall r e. (NumericFloat r e, Mutable r e, RealFloat e, Show e) => e -> Vector r e -> Property @@ -119,7 +118,7 @@ prop_Norm eps v = epsilonEq eps (sqrt (v !.! v)) (normL2 v) prop_Plus :: forall r e. - (Numeric r e, Mutable r Ix2 e, Show (Array r Ix2 e), Eq (Array r Ix2 e)) + (Numeric r e, Mutable r e, Show (Matrix r e), Eq (Matrix r e)) => Fun e e -> Matrix r e -> e @@ -135,7 +134,7 @@ prop_Plus f arr e = expectProp $ do prop_Minus :: forall r e. - (Numeric r e, Mutable r Ix2 e, Show (Array r Ix2 e), Eq (Array r Ix2 e)) + (Numeric r e, Mutable r e, Show (Array r Ix2 e), Eq (Array r Ix2 e)) => Fun e e -> Matrix r e -> e @@ -151,7 +150,7 @@ prop_Minus f arr e = expectProp $ do prop_Times :: forall r e. - (Numeric r e, Mutable r Ix2 e, Show (Array r Ix2 e), Eq (Array r Ix2 e)) + (Numeric r e, Mutable r e, Show (Matrix r e), Eq (Matrix r e)) => Fun e e -> Matrix r e -> e @@ -168,11 +167,11 @@ prop_Times f arr e = expectProp $ do prop_Divide :: forall r e. ( NumericFloat r e - , Mutable r Ix2 e + , Mutable r e , Show e , RealFloat e - , Show (Array r Ix2 e) - , Eq (Array r Ix2 e) + , Show (Matrix r e) + , Eq (Matrix r e) ) => e -- ^ Epsilon -> Fun e e @@ -190,7 +189,7 @@ prop_Divide eps f arr e = e /= 0 ==> expectProp $ do arr ./. compute (transpose arr) `shouldThrow` (== SizeMismatchException (size arr) (Sz2 n m)) prop_Floating :: - forall r e. (RealFloat e, Source r Ix2 e, NumericFloat r e, Show e) + forall r e. (RealFloat e, Source r e, NumericFloat r e, Show e) => e -> Matrix r e -> Property @@ -215,7 +214,7 @@ prop_Floating eps arr = expectProp $ do epsilonFoldableExpect eps (delay (atanhA arr)) (A.map atanh arr) prop_Floating2 :: - forall r e. (RealFloat e, Mutable r Ix2 e, NumericFloat r e, Show e) + forall r e. (RealFloat e, Mutable r e, NumericFloat r e, Show e) => e -> Matrix r e -> Fun e e @@ -231,11 +230,12 @@ prop_Floating2 eps arr1 f = expectProp $ do mutableNumericSpec :: forall r e. ( Numeric r e - , Mutable r Ix2 e + , Mutable r e + , Construct r Ix1 e + , Construct r Ix2 e , InnerSlice r Ix2 e , OuterSlice r Ix2 e - , Source (R r) Ix1 e - , Mutable r Ix1 e + , Source (R r) e , Eq e , Show e , Function e @@ -273,21 +273,19 @@ mutableNumericSpec = mutableNumericFloatSpec :: forall r. ( NumericFloat r Float - , Mutable r Ix1 Float - , Mutable r Ix2 Float - , Arbitrary (Array r Ix1 Float) - , Arbitrary (Array r Ix2 Float) - , Show (Array r Ix1 Float) - , Show (Array r Ix2 Float) - , Eq (Array r Ix2 Float) + , Mutable r Float + , Arbitrary (Vector r Float) + , Arbitrary (Matrix r Float) + , Show (Vector r Float) + , Show (Matrix r Float) + , Eq (Matrix r Float) , NumericFloat r Double - , Mutable r Ix1 Double - , Mutable r Ix2 Double - , Arbitrary (Array r Ix1 Double) - , Arbitrary (Array r Ix2 Double) - , Show (Array r Ix1 Double) - , Show (Array r Ix2 Double) - , Eq (Array r Ix2 Double) + , Mutable r Double + , Arbitrary (Vector r Double) + , Arbitrary (Matrix r Double) + , Show (Vector r Double) + , Show (Matrix r Double) + , Eq (Matrix r Double) ) => Spec mutableNumericFloatSpec = do @@ -308,6 +306,6 @@ mutableNumericFloatSpec = do prop "Power" $ prop_Power @r ed prop_Power :: - (Numeric r e, Source r Ix2 e, RealFloat e, Show e) => e -> Matrix r e -> Int -> Property + (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) diff --git a/massiv-test/src/Test/Massiv/Core/Common.hs b/massiv-test/src/Test/Massiv/Core/Common.hs index f0939107..a56d7688 100644 --- a/massiv-test/src/Test/Massiv/Core/Common.hs +++ b/massiv-test/src/Test/Massiv/Core/Common.hs @@ -112,7 +112,7 @@ instance (Show ix, Index ix, Ragged L ix e, Load DW ix e, Show e) => show windowStart ++ ") and size (" ++ show windowSize ++ ")") $ getWindow dw -instance (Arbitrary ix, CoArbitrary ix, Index ix, Arbitrary e, Typeable e) => +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 diff --git a/massiv-test/src/Test/Massiv/Core/Mutable.hs b/massiv-test/src/Test/Massiv/Core/Mutable.hs index b7eedff9..d7a24b79 100644 --- a/massiv-test/src/Test/Massiv/Core/Mutable.hs +++ b/massiv-test/src/Test/Massiv/Core/Mutable.hs @@ -25,7 +25,7 @@ import Test.Massiv.Utils prop_UnsafeNewMsize :: forall r ix e. - (Arbitrary ix, Mutable r ix e) + (Arbitrary ix, Index ix, Mutable r e) => Property prop_UnsafeNewMsize = property $ \ sz -> do marr :: MArray RealWorld r ix e <- unsafeNew sz @@ -33,7 +33,7 @@ prop_UnsafeNewMsize = property $ \ sz -> do prop_UnsafeNewLinearWriteRead :: forall r ix e. - (Eq e, Show e, Mutable r ix e, Arbitrary ix, Arbitrary e) + (Eq e, Show e, Mutable r e, Index ix, Arbitrary ix, Arbitrary e) => Property prop_UnsafeNewLinearWriteRead = property $ \ (SzIx sz ix) e1 e2 -> do marr :: MArray RealWorld r ix e <- unsafeNew sz @@ -46,7 +46,7 @@ prop_UnsafeNewLinearWriteRead = property $ \ (SzIx sz ix) e1 e2 -> do prop_UnsafeThawFreeze :: forall r ix e. - (Eq (Array r ix e), Show (Array r ix e), Mutable r ix e) + (Eq (Array r ix e), Show (Array r ix e), Index ix, Mutable r e) => Array r ix e -> Property prop_UnsafeThawFreeze arr = arr === runST (unsafeFreeze (getComp arr) =<< unsafeThaw arr) @@ -58,7 +58,8 @@ prop_UnsafeInitializeNew :: , Show e , Arbitrary e , Arbitrary ix - , Mutable r ix e + , Index ix + , Mutable r e ) => Property prop_UnsafeInitializeNew = @@ -71,7 +72,8 @@ prop_UnsafeInitialize :: ( Eq (Array r ix e) , Show (Array r ix e) , Arbitrary ix - , Mutable r ix e + , Index ix + , Mutable r e ) => Property prop_UnsafeInitialize = @@ -84,7 +86,7 @@ prop_UnsafeInitialize = prop_UnsafeLinearCopy :: - forall r ix e. (Eq (Array r ix e), Show (Array r ix e), Mutable r ix e) + forall r ix e. (Eq (Array r ix e), Show (Array r ix e), Index ix, Mutable r e) => Array r ix e -> Property prop_UnsafeLinearCopy arr = @@ -104,8 +106,8 @@ prop_UnsafeLinearCopyPart :: , Show (Vector r e) , Eq (Array r ix e) , Show (Array r ix e) - , Mutable r ix e - , Mutable r Ix1 e + , Mutable r e + , Index ix ) => ArrIx r ix e -> NonNegative Ix1 @@ -128,7 +130,7 @@ prop_UnsafeLinearCopyPart (ArrIx arr ix) (NonNegative delta) toOffset = prop_UnsafeArrayLinearCopy :: - forall r ix e. (Eq (Array r ix e), Show (Array r ix e), Mutable r ix e) + forall r ix e. (Eq (Array r ix e), Show (Array r ix e), Index ix, Mutable r e) => Array r ix e -> Property prop_UnsafeArrayLinearCopy arr = @@ -141,12 +143,7 @@ prop_UnsafeArrayLinearCopy arr = prop_UnsafeArrayLinearCopyPart :: - forall r ix e. - ( Eq (Vector r e) - , Show (Vector r e) - , Mutable r ix e - , Mutable r Ix1 e - ) + forall r ix e. (Eq (Vector r e), Show (Vector r e), Index ix, Mutable r e) => ArrIx r ix e -> NonNegative Ix1 -> Ix1 @@ -169,8 +166,8 @@ prop_UnsafeLinearSet :: forall r ix e. ( Eq (Vector r e) , Show (Vector r e) - , Mutable r ix e - , Mutable r Ix1 e + , Index ix + , Mutable r e ) => Comp -> SzIx ix @@ -193,8 +190,8 @@ prop_UnsafeLinearShrink :: forall r ix e. ( Eq (Vector r e) , Show (Vector r e) - , Mutable r ix e - , Source r Ix1 e + , Mutable r e + , Index ix ) => ArrIx r ix e -> Property @@ -216,8 +213,8 @@ prop_UnsafeLinearGrow :: , Show (Array r ix e) , Eq (Vector r e) , Show (Vector r e) - , Mutable r ix e - , Source r Ix1 e + , Mutable r e + , Index ix ) => ArrIx r ix e -> e @@ -247,10 +244,10 @@ unsafeMutableSpec :: , Show (Vector r e) , Eq (Array r ix e) , Show (Array r ix e) - , Mutable r ix e - , Mutable r Ix1 e + , Mutable r e , Show e , Eq e + , Construct r ix e , Arbitrary e , Arbitrary ix , Typeable e @@ -273,7 +270,14 @@ unsafeMutableSpec = unsafeMutableUnboxedSpec :: forall r ix e. - (Typeable e, Typeable ix, Eq (Array r ix e), Show (Array r ix e), Arbitrary ix, Mutable r ix e) + ( Typeable e + , Typeable ix + , Eq (Array r ix e) + , Show (Array r ix e) + , Index ix + , Arbitrary ix + , Mutable r e + ) => Spec unsafeMutableUnboxedSpec = describe ("Mutable Unboxed (" ++ showsArrayType @r @ix @e ") (Unsafe)") $ diff --git a/massiv-test/tests/Test/Massiv/Array/Delayed/InterleavedSpec.hs b/massiv-test/tests/Test/Massiv/Array/Delayed/InterleavedSpec.hs index e196a9ca..d73fd55e 100644 --- a/massiv-test/tests/Test/Massiv/Array/Delayed/InterleavedSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/Delayed/InterleavedSpec.hs @@ -16,10 +16,7 @@ prop_EqDelayed :: prop_EqDelayed arr = computeAs P arr === computeAs P (toInterleaved arr) -prop_Resize :: - (Ragged L ix Int, Load D ix Int, Load DI ix Int) - => Array DI ix Int - -> Property +prop_Resize :: (Ragged L ix Int) => Array DI ix Int -> Property prop_Resize arr = computeAs P (resize' k arr) === computeAs P (resize' k arrD) where diff --git a/massiv-test/tests/Test/Massiv/Array/Delayed/WindowedSpec.hs b/massiv-test/tests/Test/Massiv/Array/Delayed/WindowedSpec.hs index f52f92ca..2c5af5c0 100644 --- a/massiv-test/tests/Test/Massiv/Array/Delayed/WindowedSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/Delayed/WindowedSpec.hs @@ -3,7 +3,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-} module Test.Massiv.Array.Delayed.WindowedSpec (spec) where @@ -33,11 +32,9 @@ spec = do it "Ix3" $ property $ prop_EqDelayed (Proxy :: Proxy Ix3) it "Ix4" $ property $ prop_EqDelayed (Proxy :: Proxy Ix4) it "Ix5" $ property $ prop_EqDelayed (Proxy :: Proxy Ix5) - it "Ix2T" $ property $ prop_EqDelayed (Proxy :: Proxy Ix2T) describe "Equivalency with Stride With Delayed" $ do it "Ix1" $ property $ prop_EqDelayedStride (Proxy :: Proxy Ix1) it "Ix2" $ property $ prop_EqDelayedStride (Proxy :: Proxy Ix2) it "Ix3" $ property $ prop_EqDelayedStride (Proxy :: Proxy Ix3) it "Ix4" $ property $ prop_EqDelayedStride (Proxy :: Proxy Ix4) it "Ix5" $ property $ prop_EqDelayedStride (Proxy :: Proxy Ix5) - it "Ix2T" $ property $ prop_EqDelayedStride (Proxy :: Proxy Ix2T) diff --git a/massiv-test/tests/Test/Massiv/Array/DelayedSpec.hs b/massiv-test/tests/Test/Massiv/Array/DelayedSpec.hs index fec94753..68d94746 100644 --- a/massiv-test/tests/Test/Massiv/Array/DelayedSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/DelayedSpec.hs @@ -8,7 +8,7 @@ import Data.Massiv.Array as A import Test.Massiv.Core -downsampleArr :: Source r ix e => Stride ix -> Array r ix e -> Array D ix e +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 diff --git a/massiv-test/tests/Test/Massiv/Array/Manifest/VectorSpec.hs b/massiv-test/tests/Test/Massiv/Array/Manifest/VectorSpec.hs index 7869206c..38d59d12 100644 --- a/massiv-test/tests/Test/Massiv/Array/Manifest/VectorSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/Manifest/VectorSpec.hs @@ -16,11 +16,12 @@ import qualified Data.Vector.Unboxed as VU prop_castToFromVector :: ( VG.Vector (VRepr r) Int - , Mutable r ix Int + , Mutable r Int , Typeable (VRepr r) , ARepr (VRepr r) ~ r , Eq (Array r ix Int) , Show (Array r ix Int) + , Index ix ) => proxy ix -> r -> ArrNE r ix Int -> Property prop_castToFromVector _ _ (ArrNE arr) = @@ -29,13 +30,15 @@ prop_castToFromVector _ _ (ArrNE arr) = prop_toFromVector :: forall r ix v. - ( Mutable r ix Int - , Mutable (ARepr v) ix Int + ( Mutable r Int + , Mutable (ARepr v) Int , VRepr (ARepr v) ~ v , Eq (Array r ix Int) , VG.Vector v Int , Show (Array r ix Int) , Typeable v + , Load (ARepr v) ix Int + , Construct r ix Int ) => Proxy v -> Proxy ix diff --git a/massiv-test/tests/Test/Massiv/Array/ManifestSpec.hs b/massiv-test/tests/Test/Massiv/Array/ManifestSpec.hs index 7ec2d227..7caef620 100644 --- a/massiv-test/tests/Test/Massiv/Array/ManifestSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/ManifestSpec.hs @@ -14,10 +14,10 @@ import Data.Word (Word8) -- ByteString -prop_toFromByteString :: Manifest r Ix1 Word8 => Array r Ix1 Word8 -> Property +prop_toFromByteString :: Load r Ix1 Word8 => Manifest r Word8 => Vector r Word8 -> Property prop_toFromByteString arr = toManifest arr === fromByteString (getComp arr) (toByteString arr) -prop_castToFromByteString :: Array S Ix1 Word8 -> Property +prop_castToFromByteString :: Vector S Word8 -> Property prop_castToFromByteString arr = arr === castFromByteString (getComp arr) (castToByteString arr) diff --git a/massiv-test/tests/Test/Massiv/Array/MutableSpec.hs b/massiv-test/tests/Test/Massiv/Array/MutableSpec.hs index c03df1ef..932be094 100644 --- a/massiv-test/tests/Test/Massiv/Array/MutableSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/MutableSpec.hs @@ -29,9 +29,9 @@ type MutableArraySpec r ix e , Show (Array (R r) Ix1 e) , Load (R r) ix e , Extract r ix e - , Resize r ix + , Resize r , Arbitrary (Array r ix e) - , Mutable r ix e + , Mutable r e , Stream r ix e , Construct r ix e) @@ -84,7 +84,12 @@ specUnboxedMutableR = do unsafeMutableUnboxedSpec @r @Ix4 @e unsafeMutableUnboxedSpec @r @Ix5 @e -prop_Write :: (Mutable r ix e, Eq e, Show e) => Array r ix e -> ix -> e -> Property +prop_Write :: + forall r ix e. (Index ix, Mutable r e, Eq e, Show e) + => Array r ix e + -> ix + -> e + -> Property prop_Write arr ix e = monadicIO $ run $ do @@ -112,7 +117,12 @@ prop_Write arr ix e = index' arr'' ix `shouldBe` e -prop_Modify :: (Mutable r ix e, Eq e, Show e) => Array r ix e -> Fun e e -> ix -> Property +prop_Modify :: + forall r ix e. (Index ix, Mutable r e, Eq e, Show e) + => Array r ix e + -> Fun e e + -> ix + -> Property prop_Modify arr f ix = monadicIO $ run $ do @@ -143,7 +153,12 @@ prop_Modify arr f ix = arr'' <- withMArrayS_ arr (\ma -> modify_ ma fM ix) index' arr'' ix `shouldBe` fe -prop_Swap :: (Mutable r ix e, Eq e, Show e) => Array r ix e -> ix -> ix -> Property +prop_Swap :: + forall r ix e. (Index ix, Mutable r e, Eq e, Show e) + => Array r ix e + -> ix + -> ix + -> Property prop_Swap arr ix1 ix2 = monadicIO $ run $ do diff --git a/massiv-test/tests/Test/Massiv/Array/Ops/FoldSpec.hs b/massiv-test/tests/Test/Massiv/Array/Ops/FoldSpec.hs index f1a0f94f..42dca719 100644 --- a/massiv-test/tests/Test/Massiv/Array/Ops/FoldSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/Ops/FoldSpec.hs @@ -1,7 +1,6 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} @@ -24,7 +23,7 @@ prop_ProdSEqProdP :: Index ix => Array D ix Int -> Bool prop_ProdSEqProdP arr = product arr == product (setComp Par arr) -foldOpsProp :: Source P ix Int => Fun Int Bool -> ArrTinyNE P ix Int -> Expectation +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) diff --git a/massiv-test/tests/Test/Massiv/Array/Ops/MapSpec.hs b/massiv-test/tests/Test/Massiv/Array/Ops/MapSpec.hs index dd14aa94..9fdd2d82 100644 --- a/massiv-test/tests/Test/Massiv/Array/Ops/MapSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/Ops/MapSpec.hs @@ -139,8 +139,8 @@ spec = do alt_imapM - :: (Applicative f, Mutable r2 t1 b, Source r1 t1 t2) => - (t1 -> t2 -> f b) -> Array r1 t1 t2 -> f (Array r2 t1 b) + :: (Applicative f, Index ix, Mutable 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 (:) [] (zipWithIndex arr) where loadList xs = @@ -150,7 +150,7 @@ alt_imapM f arr = fmap loadList $ P.traverse (uncurry f) $ foldrS (:) [] (zipWit unsafeFreeze (getComp arr) marr {-# INLINE loadList #-} -zipWithIndex :: forall r ix e . Source r ix e => Array r ix e -> Array D ix (ix, e) +zipWithIndex :: forall r ix e . (Index ix, Source r e) => Array r ix e -> Array D ix (ix, e) zipWithIndex arr = A.zip (range Seq zeroIndex (unSz (size arr))) arr {-# INLINE zipWithIndex #-} diff --git a/massiv-test/tests/Test/Massiv/Array/Ops/TransformSpec.hs b/massiv-test/tests/Test/Massiv/Array/Ops/TransformSpec.hs index 0644536e..d86783cc 100644 --- a/massiv-test/tests/Test/Massiv/Array/Ops/TransformSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/Ops/TransformSpec.hs @@ -17,11 +17,11 @@ import Prelude as P import Test.Massiv.Core import Test.Massiv.Array.Delayed (stackSlices') -prop_TransposeOuterInner :: Array D Ix2 Int -> Property +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), Mutable r ix e) + forall r ix e . (Eq (Array r ix e), Show (Array r ix e), Load r ix e, Mutable r e) => ArrTiny r ix e -> Stride ix -> e @@ -33,9 +33,9 @@ prop_ExtractAppend :: forall r ix e. ( Eq (Array r ix e) , Show (Array r ix e) - , Source (R r) ix e + , Source (R r) e , Extract r ix e - , Mutable r ix e + , Mutable r e ) => DimIx ix -> ArrIx r ix e @@ -49,8 +49,9 @@ prop_SplitExtract :: , Eq (Array (R r) ix e) , Show (Array r ix e) , Show (Array (R r) ix e) - , Source (R r) ix e - , Mutable r ix e + , Source (R r) e + , Load (R r) ix e + , Mutable r e , Extract r ix e ) => DimIx ix @@ -67,7 +68,7 @@ prop_SplitExtract (DimIx dim) (ArrIx arr ix) (Positive n) = (splitLeft, splitRight) = splitAt' dim (i + n') arr prop_ConcatAppend :: - forall r ix. (Eq (Array r ix Int), Show (Array r ix Int), Mutable r ix Int) + forall r ix. (Eq (Array r ix Int), Show (Array r ix Int), Construct r ix Int, Mutable r Int) => DimIx ix -> Comp -> Sz ix @@ -80,7 +81,8 @@ prop_ConcatAppend (DimIx dim) comp sz (NonEmpty fns) = 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), Mutable r ix Int) + forall r ix. + (Eq (Array r ix Int), Show (Array r ix Int), Construct r ix Int, Mutable r Int) => Comp -> Sz ix -> NonEmptyList (Fun ix Int) @@ -105,7 +107,7 @@ prop_ConcatMconcat arrs = computeAs P (concat' 1 (A.empty : arrs)) === computeAs P (mconcat (fmap toLoadArray arrs)) prop_ExtractSizeMismatch :: - (Resize r ix, Load r ix e, NFData (Array r Int e)) => ArrTiny r ix e -> Positive Int -> Property + (Resize 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 where @@ -175,7 +177,7 @@ prop_ZoomWithGridStrideCompute :: , Show (Array r ix e) , StrideLoad (R r) ix e , StrideLoad r ix e - , Mutable r ix e + , Mutable r e , Extract r ix e ) => Array r ix e @@ -192,7 +194,7 @@ prop_ZoomWithGridStrideCompute arr stride defVal = 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, Mutable r ix e) + forall r ix e. (Eq (Array r ix e), Show (Array r ix e), StrideLoad r ix e, Mutable r e) => Array r ix e -> Stride ix -> Property @@ -220,13 +222,15 @@ type Transform r ix e , Show (Array r ix Int) , NFData (Array r ix e) , NFData (Array r Int e) - , Resize r ix + , Resize r , Extract r ix e - , Source (R r) ix e + , Construct r ix e + , Construct r ix Int + , Source (R r) e , StrideLoad r ix e , StrideLoad (R r) ix e - , Mutable r ix Int - , Mutable r ix e) + , Mutable r Int + , Mutable r e) specTransformR :: forall r ix e. Transform r ix e diff --git a/massiv-test/tests/Test/Massiv/Array/StencilSpec.hs b/massiv-test/tests/Test/Massiv/Array/StencilSpec.hs index 93fc962d..5b793b6b 100644 --- a/massiv-test/tests/Test/Massiv/Array/StencilSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/StencilSpec.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} @@ -25,38 +26,33 @@ singletonStencil f = makeStencil oneSz zeroIndex $ \ get -> f (get zeroIndex) -prop_MapSingletonStencil :: - (Load DW ix Int, Manifest U ix Int, Show (Array U ix Int)) - => Proxy ix - -> Fun Int Int - -> Border Int - -> ArrNE U 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 U (mapStencil b (singletonStencil (apply f)) arr) === computeAs U (A.map (apply f) arr) + computeAs P (mapStencil b (singletonStencil (apply f)) arr) === computeAs P (A.map (apply f) arr) prop_ApplyZeroStencil :: - (Load DW ix Int, Show (Array U ix Int), Manifest U ix Int) + (Load DW ix Int, Show (Array P ix Int)) => Proxy ix -> Int - -> Array U ix Int + -> Array P ix Int -> Property prop_ApplyZeroStencil _ e arr = - computeAs U (applyStencil noPadding zeroStencil arr) === makeArray Seq (size arr) (const e) + 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, Manifest U ix Int, Show (Array U ix Int)) + (StrideLoad DW ix Int, Show (Array P ix Int)) => Proxy ix -> Fun Int Int -> Border Int - -> ArrNE U ix Int + -> ArrNE P ix Int -> Property prop_MapSingletonStencilWithStride _ f b (ArrNE arr) = computeWithStride oneStride (mapStencil b (singletonStencil (apply f)) arr) === - computeAs U (A.map (apply f) arr) + computeAs P (A.map (apply f) arr) -- Tests out of bounds stencil indexing prop_DangerousStencil :: @@ -82,6 +78,28 @@ instance Index ix => Show (Stencil ix a b) where show stencil = "Stencil " ++ show (getStencilSize stencil) ++ " " ++ show (getStencilCenter stencil) +unsafeMapStencil :: + (Index ix, Manifest r e) + => Border e + -> Sz ix + -> ix + -> (ix -> (ix -> e) -> a) + -> Array r ix e + -> Array DW ix a +unsafeMapStencil b sSz sCenter stencilF !arr = insertWindow warr window + where + !warr = makeArray (getComp arr) sz (stencil (borderIndex b arr)) + !window = + Window + { windowStart = sCenter + , windowSize = windowSz + , windowIndex = stencil (unsafeIndex arr) + , windowUnrollIx2 = unSz . fst <$> pullOutSzM sSz 2 + } + !sz = size arr + !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) @@ -131,7 +149,6 @@ stencilSpec = do it "Ix2" $ property $ prop_MapSingletonStencil (Proxy :: Proxy Ix2) it "Ix3" $ property $ prop_MapSingletonStencil (Proxy :: Proxy Ix3) it "Ix4" $ property $ prop_MapSingletonStencil (Proxy :: Proxy Ix4) - it "Ix2T" $ property $ prop_MapSingletonStencil (Proxy :: Proxy Ix2T) describe "MapSingletonStencilWithStride" $ do it "Ix1" $ property $ prop_MapSingletonStencilWithStride (Proxy :: Proxy Ix1) it "Ix2" $ property $ prop_MapSingletonStencilWithStride (Proxy :: Proxy Ix2) @@ -141,7 +158,6 @@ stencilSpec = do it "Ix2" $ property $ prop_ApplyZeroStencil (Proxy :: Proxy Ix2) it "Ix3" $ property $ prop_ApplyZeroStencil (Proxy :: Proxy Ix3) it "Ix4" $ property $ prop_ApplyZeroStencil (Proxy :: Proxy Ix4) - it "Ix2T" $ property $ prop_ApplyZeroStencil (Proxy :: Proxy Ix2T) describe "DangerousStencil" $ do it "Ix1" $ property $ prop_DangerousStencil (Proxy :: Proxy Ix1) it "Ix2" $ property $ prop_DangerousStencil (Proxy :: Proxy Ix2) @@ -165,23 +181,23 @@ stencilSpec = do let stencil = makeStencil sz ix ($ Ix1 0) :: Stencil Ix1 Int Int in getStencilSize stencil === sz .&&. getStencilCenter stencil === ix -stencilDirection :: Ix2 -> Array U Ix2 Int -> Array U Ix2 Int -stencilDirection ix = computeAs U . mapStencil (Fill 0) (makeStencil (Sz 3) (1 :. 1) $ \f -> f 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 -> Array U Ix2 Int -> Array U Ix2 Int -stencilCorners ixC ix = computeAs U . mapStencil (Fill 0) (makeStencil (Sz 3) ixC $ \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 U Ix1 Int + let xs3 :: Array P Ix1 Int xs3 = [1, 2, 3] xs3f f = f (-1) 1 . f 0 2 . f 1 3 - xs4 :: Array U Ix1 Int + xs4 :: Array P Ix1 Int xs4 = [1, 2, 3, 4] xs4f f = f (-2) 1 . f (-1) 2 . f 0 3 . f 1 4 - ys :: Array U Ix1 Int + ys :: Array P Ix1 Int ys = [1, 2, 3, 4, 5] ysConvXs3 = [4, 10, 16, 22, 22] ysConvXs4 = [10, 20, 30, 34, 31] @@ -190,12 +206,12 @@ stencilConvolution = do ysConvXs4' = [4, 10, 20, 30, 34] ysCorrXs4' = [20, 30, 40, 26, 14] xs4f' f = f (-1) 1 . f 0 2 . f 1 3 . f 2 4 - mapStencil1 :: Stencil Ix1 Int Int -> Array U Ix1 Int -> Array U Ix1 Int - mapStencil1 s = computeAs U . mapStencil (Fill 0) s - mapStencil2 :: Stencil Ix2 Int Int -> Array U Ix2 Int -> Array U Ix2 Int - mapStencil2 s = computeAs U . mapStencil (Fill 0) s - applyStencil1 :: Stencil Ix1 Int Int -> Array U Ix1 Int -> Array U Ix1 Int - applyStencil1 s = computeAs U . applyStencil noPadding s + mapStencil1 :: Stencil Ix1 Int Int -> Array P Ix1 Int -> Array P Ix1 Int + mapStencil1 s = computeAs P . mapStencil (Fill 0) s + mapStencil2 :: Stencil Ix2 Int Int -> Array P Ix2 Int -> Array P Ix2 Int + mapStencil2 s = computeAs P . mapStencil (Fill 0) s + applyStencil1 :: Stencil Ix1 Int Int -> Array P Ix1 Int -> Array P Ix1 Int + applyStencil1 s = computeAs P . applyStencil noPadding s describe "makeConvolutionStencilFromKernel" $ do it "1x3 map" $ mapStencil1 (makeConvolutionStencilFromKernel xs3) ys `shouldBe` ysConvXs3 it "1x4 map" $ mapStencil1 (makeConvolutionStencilFromKernel xs4) ys `shouldBe` ysConvXs4 @@ -218,41 +234,41 @@ stencilConvolution = do it "1x4" $ mapStencil1 (makeCorrelationStencil (Sz1 4) 1 xs4f') ys `shouldBe` ysCorrXs4' describe "makeConvolutionStencil == makeConvolutionStencilFromKernel" $ do it "Sobel Horizontal" $ - property $ \(arr :: Array U Ix2 Int) -> + property $ \(arr :: Array P Ix2 Int) -> mapStencil2 (makeConvolutionStencil (Sz 3) 1 sobelX) arr === mapStencil2 (makeConvolutionStencilFromKernel sobelKernelX) arr it "1x3" $ - property $ \(arr :: Array U Ix1 Int) -> + property $ \(arr :: Array P Ix1 Int) -> mapStencil1 (makeConvolutionStencil (Sz1 3) 1 xs3f) arr === mapStencil1 (makeConvolutionStencilFromKernel xs3) arr it "1x4" $ - property $ \(arr :: Array U Ix1 Int) -> + property $ \(arr :: Array P Ix1 Int) -> mapStencil1 (makeConvolutionStencil (Sz1 4) 2 xs4f) arr === mapStencil1 (makeConvolutionStencilFromKernel xs4) arr describe "makeCorrelationStencil == makeCorrelationStencilFromKernel" $ do it "Sobel Horizontal" $ - property $ \(arr :: Array U Ix2 Int) -> + property $ \(arr :: Array P Ix2 Int) -> mapStencil2 (makeCorrelationStencil (Sz 3) 1 sobelX) arr === mapStencil2 (makeCorrelationStencilFromKernel sobelKernelX) arr it "1x3" $ - property $ \(arr :: Array U Ix1 Int) -> + property $ \(arr :: Array P Ix1 Int) -> mapStencil1 (makeCorrelationStencil (Sz1 3) 1 xs3f) arr === mapStencil1 (makeCorrelationStencilFromKernel xs3) arr it "1x4" $ - property $ \(arr :: Array U Ix1 Int) -> + property $ \(arr :: Array P Ix1 Int) -> mapStencil1 (makeCorrelationStencil (Sz1 4) 2 xs4f) arr === mapStencil1 (makeCorrelationStencilFromKernel xs4) arr describe "makeConvolutionStencil == makeCorrelationStencil . rotate180" $ do it "Sobel Horizontal" $ - property $ \(arr :: Array U Ix2 Int) -> + property $ \(arr :: Array P Ix2 Int) -> mapStencil2 (makeConvolutionStencilFromKernel sobelKernelX) arr === mapStencil2 (makeCorrelationStencilFromKernel (rotate180 sobelKernelX)) arr it "1x3" $ - property $ \(arr :: Array U Ix1 Int) -> + property $ \(arr :: Array P Ix1 Int) -> mapStencil1 (makeConvolutionStencilFromKernel xs3) arr === mapStencil1 (makeCorrelationStencilFromKernel (rotate180 xs3)) arr it "1x5" $ - property $ \(arr :: Array U Ix1 Int) -> + property $ \(arr :: Array P Ix1 Int) -> mapStencil1 (makeConvolutionStencilFromKernel ys) arr === mapStencil1 (makeCorrelationStencilFromKernel (rotate180 ys)) arr @@ -260,7 +276,7 @@ spec :: Spec spec = do describe "Stencil" $ do stencilSpec - let arr = [[1, 2, 3], [4, 5, 6], [7, 8, 9]] :: Array U Ix2 Int + let arr = [[1, 2, 3], [4, 5, 6], [7, 8, 9]] :: Array P Ix2 Int describe "Unit tests Ix2" $ do it "Direction Left" $ stencilDirection (0 :. 1) arr `shouldBe` [[2, 3, 0], [5, 6, 0], [8, 9, 0]] @@ -268,7 +284,7 @@ spec = do stencilDirection (0 :. -1) arr `shouldBe` [[0, 1, 2], [0, 4, 5], [0, 7, 8]] it "Direction Down" $ stencilDirection (1 :. 0) arr `shouldBe` [[4, 5, 6], [7, 8, 9], [0, 0, 0]] - it "Direction Up" $ + it "Direction Pp" $ stencilDirection (-1 :. 0) arr `shouldBe` [[0, 0, 0], [1, 2, 3], [4, 5, 6]] it "Direction Left/Top Corner" $ stencilCorners (0 :. 0) (2 :. 2) arr `shouldBe` [[9, 0, 0], [0, 0, 0], [0, 0, 0]] @@ -279,16 +295,16 @@ spec = do it "Direction Left/Bottom Corner" $ stencilCorners (2 :. 0) (-2 :. 2) arr `shouldBe` [[0, 0, 0], [0, 0, 0], [3, 0, 0]] describe "mapStencil with stride" $ do - let kernel = [[-1, 0, 1], [0, 1, 0], [-1, 0, 1]] :: Array U Ix2 Int + let kernel = [[-1, 0, 1], [0, 1, 0], [-1, 0, 1]] :: Array P Ix2 Int stencil = makeConvolutionStencilFromKernel kernel stride = Stride 2 it "map stencil with stride on small array" $ let strideArr = mapStencil (Fill 0) stencil arr - in computeWithStrideAs U stride strideArr `shouldBe` [[-4, 8], [2, 14]] + in computeWithStrideAs P stride strideArr `shouldBe` [[-4, 8], [2, 14]] it "map stencil with stride on larger array" $ - let largeArr = makeArrayR U Seq (Sz 5) (succ . toLinearIndex (Sz 5)) + let largeArr = makeArrayR P Seq (Sz 5) (succ . toLinearIndex (Sz 5)) strideArr = mapStencil (Fill 0) stencil largeArr - in computeWithStrideAs U stride strideArr `shouldBe` + in computeWithStrideAs P stride strideArr `shouldBe` [[-6, 1, 14], [-13, 9, 43], [4, 21, 44]] stencilConvolution @@ -297,10 +313,10 @@ 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 U Ix2 Int +sobelKernelX :: Array P Ix2 Int sobelKernelX = [ [-1, 0, 1] , [-2, 0, 2] , [-1, 0, 1] ] -rotate180 :: (Num ix, Index ix) => Array U ix Int -> Array U ix Int -rotate180 = computeAs U . transform' (\sz -> (sz, sz)) (\(Sz sz) f ix -> f (sz - 1 - ix)) +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)) diff --git a/massiv-test/tests/Test/Massiv/ArraySpec.hs b/massiv-test/tests/Test/Massiv/ArraySpec.hs index 4103dc4a..23402007 100644 --- a/massiv-test/tests/Test/Massiv/ArraySpec.hs +++ b/massiv-test/tests/Test/Massiv/ArraySpec.hs @@ -13,7 +13,7 @@ import Test.Massiv.Core prop_Construct_makeArray_Manifest :: - forall r ix. (Load D ix Int, Ragged L ix Int, Source r ix Int, Construct r ix Int) + forall r ix. (Load D ix Int, Ragged L ix Int, Source r Int, Construct r ix Int) => Comp -> Sz ix -> Fun Int Int @@ -23,7 +23,7 @@ prop_Construct_makeArray_Manifest comp sz f = delay (setComp Seq (makeArray comp sz (apply f . toLinearIndex sz) :: Array r ix Int)) prop_Construct_makeArray_Delayed :: - forall r ix. (Load D ix Int, Ragged L ix Int, Load r ix Int, Construct r ix Int) + forall r ix. (Load D ix Int, Ragged L ix Int, Construct r ix Int) => Comp -> Sz ix -> Fun Int Int @@ -34,7 +34,7 @@ prop_Construct_makeArray_Delayed comp sz f = prop_Functor :: forall r ix. - (Load D ix Int, Ragged L ix Int, Load r ix Int, Construct r ix Int, Functor (Array r ix)) + (Load D ix Int, Ragged L ix Int, Construct r ix Int, Functor (Array r ix)) => Comp -> Sz ix -> Fun Int Int @@ -70,7 +70,7 @@ prop_IxUnbox :: ( Load D ix ix , Ragged L ix ix , Construct U ix ix - , Source U ix ix + , Source U ix ) => Comp -> Sz ix diff --git a/massiv-test/tests/Test/Massiv/VectorSpec.hs b/massiv-test/tests/Test/Massiv/VectorSpec.hs index c1fe399b..d5cd6222 100644 --- a/massiv-test/tests/Test/Massiv/VectorSpec.hs +++ b/massiv-test/tests/Test/Massiv/VectorSpec.hs @@ -159,11 +159,12 @@ 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 (!==!) arr vec = toPrimitiveVector (convert arr) === vec -(!!==!!) :: (Eq e, Show e, Prim e, Source 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 - Right vec' -> toPrimitiveVector (computeSource arr) `shouldBe` vec' + Right vec' -> toPrimitiveVector (compute arr) `shouldBe` vec' Left (_exc :: ErrorCall) -> shouldThrow (pure $! computeAs P arr) sizeException @@ -955,7 +956,7 @@ spec = prop "fmap" $ \(v :: Vector DS Word) (f :: Fun Word Int) -> fmap (apply f) v !==! VP.map (apply f) (toPrimitiveVector (compute v)) prop "<$" $ \(v :: Vector DS Word) (a :: Char) -> - (a <$ v) !==! VP.replicate (totalElem (size v)) a + (a <$ v) !==! VP.replicate (length v) a prop "smap" $ \(v :: Vector P Word) (f :: Fun Word Int) -> V.smap (apply f) v !==! VP.map (apply f) (toPrimitiveVector v) prop "simap" $ \(v :: Vector P Word) (f :: Fun (Int, Word) Int) -> diff --git a/massiv/CHANGELOG.md b/massiv/CHANGELOG.md index 0645a4f0..f996c58a 100644 --- a/massiv/CHANGELOG.md +++ b/massiv/CHANGELOG.md @@ -1,3 +1,18 @@ +# 1.0.0 + +* Introduce `Shape`, the parent of `Size` +* Move `size` from `Load` into new class `Size` +* Removed `maxSize` and replaced it with `maxLinearSize` +* Remove specialized `DW` instances that used tuples as indices. +* Remove `OuterSlice L` instance +* Add `Strategy` and move `setComp` (from `Construct`) and `getComp` (from `Load`) in there. +* Remove `ix` from `Mutable` +* Remove `ix` from `Manifest` +* Remove `ix` from `Source` +* Remove `ix` from `Resize` +* Prevent `showsArrayPrec` from changing index type +* Change function argument to monadic action for `unstablePartitionM` and `unsafeUnstablePartitionM` + # 0.6.1 * Addition of `withLoadMArray_`, `withLoadMArrayS`, `withLoadMArrayS_`, @@ -6,6 +21,7 @@ * Addition of `quicksortBy`, `quicksortByM` and `quicksortByM_` * Fix performance regression for `quicksort` and `quicksortM_` introduced in previous release. + # 0.6.0 * Fix semantics of `Applicative`, `Num` and `Fractional` instance for `D` arrays: diff --git a/massiv/src/Data/Massiv/Array/Delayed/Interleaved.hs b/massiv/src/Data/Massiv/Array/Delayed/Interleaved.hs index 39668751..5c4ef345 100644 --- a/massiv/src/Data/Massiv/Array/Delayed/Interleaved.hs +++ b/massiv/src/Data/Massiv/Array/Delayed/Interleaved.hs @@ -36,14 +36,27 @@ instance (Ragged L ix e, Show e) => Show (Array DI ix e) where showsPrec = showsArrayPrec diArray showList = showArrayList -instance Index ix => Construct DI ix e where +instance Strategy DI where setComp c arr = arr { diArray = (diArray arr) { dComp = c } } {-# INLINE setComp #-} + getComp = dComp . diArray + {-# INLINE getComp #-} + +instance Index ix => Construct DI ix e where makeArray c sz = DIArray . makeArray c sz {-# INLINE makeArray #-} -instance Index ix => Resize DI ix where +instance Index ix => Shape DI ix where + maxLinearSize = Just . SafeSz . elemsCount + {-# INLINE maxLinearSize #-} + + +instance Size DI where + size (DIArray arr) = size arr + {-# INLINE size #-} + +instance Resize DI where unsafeResize sz = DIArray . unsafeResize sz . diArray {-# INLINE unsafeResize #-} @@ -53,10 +66,6 @@ instance Index ix => Extract DI ix e where instance Index ix => Load DI ix e where - size (DIArray arr) = size arr - {-# INLINE size #-} - getComp = dComp . diArray - {-# INLINE getComp #-} loadArrayM scheduler (DIArray (DArray _ sz f)) uWrite = loopM_ 0 (< numWorkers scheduler) (+ 1) $ \ !start -> scheduleWork scheduler $ @@ -75,7 +84,7 @@ instance Index ix => StrideLoad DI ix e where -- | Convert a source array into an array that, when computed, will have its elemets evaluated out -- of order (interleaved amongst cores), hence making unbalanced computation better parallelizable. -toInterleaved :: Source r ix e => Array r ix e -> Array DI ix e +toInterleaved :: (Index ix, Source r e) => Array r ix e -> Array DI ix e toInterleaved = DIArray . delay {-# INLINE toInterleaved #-} diff --git a/massiv/src/Data/Massiv/Array/Delayed/Pull.hs b/massiv/src/Data/Massiv/Array/Delayed/Pull.hs index 2d9b1ae3..b863cc89 100644 --- a/massiv/src/Data/Massiv/Array/Delayed/Pull.hs +++ b/massiv/src/Data/Massiv/Array/Delayed/Pull.hs @@ -47,7 +47,15 @@ instance (Ragged L ix e, Show e) => Show (Array D ix e) where showsPrec = showsArrayPrec id showList = showArrayList -instance Index ix => Resize D ix where +instance Index ix => Shape D ix where + maxLinearSize = Just . SafeSz . elemsCount + {-# INLINE maxLinearSize #-} + +instance Size D where + size = dSize + {-# INLINE size #-} + +instance Resize D where unsafeResize !sz !arr = DArray (dComp arr) sz $ \ !ix -> unsafeIndex arr (fromLinearIndex (size arr) (toLinearIndex sz ix)) @@ -59,16 +67,18 @@ instance Index ix => Extract D ix e where unsafeIndex arr (liftIndex2 (+) ix sIx) {-# INLINE unsafeExtract #-} - -instance Index ix => Construct D ix e where +instance Strategy D where setComp c arr = arr { dComp = c } {-# INLINE setComp #-} + getComp = dComp + {-# INLINE getComp #-} +instance Index ix => Construct D ix e where makeArray = DArray {-# INLINE makeArray #-} -instance Index ix => Source D ix e where +instance Source D e where unsafeIndex = INDEX_CHECK("(Source D ix e).unsafeIndex", size, dIndex) {-# INLINE unsafeIndex #-} unsafeLinearSlice !o !sz arr = @@ -147,10 +157,6 @@ instance Index ix => Foldable (Array D ix) where instance Index ix => Load D ix e where - size = dSize - {-# INLINE size #-} - getComp = dComp - {-# INLINE getComp #-} loadArrayM !scheduler !arr = splitLinearlyWith_ scheduler (elemsCount arr) (unsafeLinearIndex arr) {-# INLINE loadArrayM #-} @@ -163,7 +169,7 @@ instance Index ix => Stream D ix e where {-# INLINE toStreamIx #-} -- | Map an index aware function over an array -imap :: Source r ix e' => (ix -> e' -> e) -> Array r ix e' -> Array D ix e +imap :: (Index ix, Source r e') => (ix -> e' -> e) -> Array r ix e' -> Array D ix e imap f !arr = DArray (getComp arr) (size arr) (\ !ix -> f ix (unsafeIndex arr ix)) {-# INLINE imap #-} @@ -239,7 +245,7 @@ instance Floating e => NumericFloat D e -- | /O(1)/ Conversion from a source array to `D` representation. -delay :: Source r ix e => Array r ix e -> Array D ix e +delay :: (Index ix, Source r e) => Array r ix e -> Array D ix e delay arr = DArray (getComp arr) (size arr) (unsafeIndex arr) {-# INLINE [1] delay #-} @@ -250,8 +256,8 @@ delay arr = DArray (getComp arr) (size arr) (unsafeIndex arr) -- | /O(min (n1, n2))/ - Compute array equality by applying a comparing function to each element. -- -- @since 0.5.7 -eqArrays :: (Source r1 ix e1, Source r2 ix e2) => - (e1 -> e2 -> Bool) -> Array r1 ix e1 -> Array r2 ix e2 -> Bool +eqArrays :: (Index ix, Source r1 e1, Source r2 e2) => + (e1 -> e2 -> Bool) -> Array r1 ix e1 -> Array r2 ix e2 -> Bool eqArrays f arr1 arr2 = (size arr1 == size arr2) && not (A.any not @@ -264,7 +270,7 @@ eqArrays f arr1 arr2 = -- you need an ordering but do not care about which one is used. -- -- @since 0.5.7 -compareArrays :: (Source r1 ix e1, Source r2 ix e2) => +compareArrays :: (Index ix, Source r1 e1, Source r2 e2) => (e1 -> e2 -> Ordering) -> Array r1 ix e1 -> Array r2 ix e2 -> Ordering compareArrays f arr1 arr2 = compare (size arr1) (size arr2) <> @@ -275,7 +281,7 @@ compareArrays f arr1 arr2 = liftArray2Matching - :: (Source r1 ix a, Source r2 ix b) + :: (Index ix, Source r1 a, Source r2 b) => (a -> b -> e) -> Array r1 ix a -> Array r2 ix b -> Array D ix e liftArray2Matching f !arr1 !arr2 | sz1 == sz2 = diff --git a/massiv/src/Data/Massiv/Array/Delayed/Push.hs b/massiv/src/Data/Massiv/Array/Delayed/Push.hs index 5e6a7e8c..1cc65e08 100644 --- a/massiv/src/Data/Massiv/Array/Delayed/Push.hs +++ b/massiv/src/Data/Massiv/Array/Delayed/Push.hs @@ -53,9 +53,14 @@ data instance Array DL ix e = DLArray -> m () } -instance Index ix => Construct DL ix e where +instance Strategy DL where + getComp = dlComp + {-# INLINE getComp #-} setComp c arr = arr {dlComp = c} {-# INLINE setComp #-} + + +instance Index ix => Construct DL ix e where makeArrayLinear comp sz f = DLArray comp sz load where load :: Monad m => @@ -67,7 +72,16 @@ instance Index ix => Construct DL ix e where replicate comp !sz !e = makeLoadArray comp sz e $ \_ _ -> pure () {-# INLINE replicate #-} -instance Index ix => Resize DL ix where +instance Index ix => Shape DL ix where + maxLinearSize = Just . SafeSz . elemsCount + {-# INLINE maxLinearSize #-} + + +instance Size DL where + size = dlSize + {-# INLINE size #-} + +instance Resize DL where unsafeResize !sz arr = arr { dlSize = sz } {-# INLINE unsafeResize #-} @@ -277,7 +291,7 @@ unsafeMakeLoadArrayAdjusted comp sz mDefVal writer = DLArray comp sz load -- -- @since 0.3.0 toLoadArray :: - forall r ix e. Load r ix e + forall r ix e. (Size r, Load r ix e) => Array r ix e -> Array DL ix e toLoadArray arr = DLArray (getComp arr) sz load @@ -295,7 +309,7 @@ toLoadArray arr = DLArray (getComp arr) sz load -- -- @since 0.3.0 fromStrideLoad :: - forall r ix e. StrideLoad r ix e + forall r ix e. (StrideLoad r ix e) => Stride ix -> Array r ix e -> Array DL ix e @@ -311,10 +325,6 @@ fromStrideLoad stride arr = {-# INLINE fromStrideLoad #-} instance Index ix => Load DL ix e where - size = dlSize - {-# INLINE size #-} - getComp = dlComp - {-# INLINE getComp #-} loadArrayWithSetM scheduler DLArray {dlLoad} = dlLoad scheduler 0 {-# INLINE loadArrayWithSetM #-} diff --git a/massiv/src/Data/Massiv/Array/Delayed/Stream.hs b/massiv/src/Data/Massiv/Array/Delayed/Stream.hs index 7649579b..7792414c 100644 --- a/massiv/src/Data/Massiv/Array/Delayed/Stream.hs +++ b/massiv/src/Data/Massiv/Array/Delayed/Stream.hs @@ -31,7 +31,6 @@ import qualified Data.Massiv.Vector.Stream as S import Data.Massiv.Core.Common import GHC.Exts import Prelude hiding (take, drop) -import Data.Vector.Fusion.Bundle.Size (upperBound) -- | Delayed stream array that represents a sequence of values that can be loaded -- sequentially. Important distinction from other arrays is that its size might no be @@ -64,6 +63,26 @@ fromStepsM = fmap DSArray . S.transSteps {-# INLINE fromStepsM #-} +instance Shape DS Ix1 where + linearSizeHint = stepsSize . dsArray + {-# INLINE linearSizeHint #-} + + linearSize = SafeSz . unId . S.length . dsArray + {-# INLINE linearSize #-} + + outerSize = linearSize + {-# INLINE outerSize #-} + + isEmpty = S.unId . S.null . coerce + {-# INLINE isEmpty #-} + + +--TODO remove +instance Strategy DS where + getComp _ = Seq + setComp _ = id + + instance Functor (Array DS Ix1) where fmap f = coerce . S.map f . dsArray {-# INLINE fmap #-} @@ -114,8 +133,6 @@ instance Foldable (Array DS Ix1) where minimum = S.unId . S.foldl1 min . toSteps {-# INLINE minimum #-} - - instance Semigroup (Array DS Ix1 e) where (<>) a1 a2 = fromSteps (coerce a1 `S.append` coerce a2) {-# INLINE (<>) #-} @@ -147,7 +164,7 @@ instance S.Stream DS Ix1 e where -- | Flatten an array into a stream of values. -- -- @since 0.4.1 -toStreamArray :: Source r ix e => Array r ix e -> Array DS Ix1 e +toStreamArray :: (Index ix, Source r e) => Array r ix e -> Array DS Ix1 e toStreamArray = DSArray . S.steps {-# INLINE[1] toStreamArray #-} {-# RULES "toStreamArray/id" toStreamArray = id #-} @@ -168,34 +185,21 @@ toStreamIxM = S.transStepsId . toStreamIx instance Construct DS Ix1 e where - setComp _ arr = arr - {-# INLINE setComp #-} - makeArrayLinear _ (Sz k) = fromSteps . S.generate k + makeArrayLinear _ k = fromSteps . S.generate k {-# INLINE makeArrayLinear #-} -instance Extract DS Ix1 e where - unsafeExtract sIx newSz = fromSteps . S.slice sIx (unSz newSz) . dsArray - {-# INLINE unsafeExtract #-} +-- instance Extract DS Ix1 e where +-- unsafeExtract sIx newSz = fromSteps . S.slice sIx (unSz newSz) . dsArray +-- {-# INLINE unsafeExtract #-} -- | /O(n)/ - `size` implementation. instance Load DS Ix1 e where - size = coerce . S.unId . S.length . coerce - {-# INLINE size #-} - - maxSize = coerce . upperBound . stepsSize . dsArray - {-# INLINE maxSize #-} - - isEmpty = S.unId . S.null . coerce - {-# INLINE isEmpty #-} - - getComp _ = Seq - {-# INLINE getComp #-} loadArrayM _scheduler arr uWrite = case stepsSize (dsArray arr) of - S.Exact _ -> + LengthExact _ -> void $ S.foldlM (\i e -> uWrite i e >> pure (i + 1)) 0 (S.transStepsId (coerce arr)) _ -> error "Loading Stream array is not supported with loadArrayM" {-# INLINE loadArrayM #-} diff --git a/massiv/src/Data/Massiv/Array/Delayed/Windowed.hs b/massiv/src/Data/Massiv/Array/Delayed/Windowed.hs index 26c72de2..2a2d5c27 100644 --- a/massiv/src/Data/Massiv/Array/Delayed/Windowed.hs +++ b/massiv/src/Data/Massiv/Array/Delayed/Windowed.hs @@ -62,11 +62,14 @@ instance (Ragged L ix e, Load DW ix e, Show e) => Show (Array DW ix e) where showsPrec = showsArrayPrec (computeAs B) showList = showArrayList - -instance Index ix => Construct DW ix e where - +instance Strategy DW where setComp c arr = arr { dwArray = (dwArray arr) { dComp = c } } {-# INLINE setComp #-} + getComp = dComp . dwArray + {-# INLINE getComp #-} + + +instance Load DW ix e => Construct DW ix e where makeArray c sz f = DWArray (makeArray c sz f) Nothing {-# INLINE makeArray #-} @@ -122,7 +125,7 @@ instance Functor (Array DW ix) where -- -- @since 0.1.3 makeWindowedArray - :: Source r ix e + :: (Index ix, Source r e) => Array r ix e -- ^ Source array that will have a window inserted into it -> ix -- ^ Start index for the window -> Sz ix -- ^ Size of the window @@ -138,7 +141,7 @@ makeWindowedArray !arr wStart wSize wIndex = -- -- @since 0.3.0 insertWindow - :: Source D ix e + :: Index ix => Array D ix e -- ^ Source array that will have a window inserted into it -> Window ix e -- ^ Window to place inside the delayed array -> Array DW ix e @@ -209,12 +212,16 @@ loadWithIx1 with (DWArray (DArray _ sz indexB) mWindow) uWrite = do return (\from to -> with $ iterM_ from to 1 (<) $ \ !i -> uWrite i (indexW i), it, wEnd) {-# INLINE loadWithIx1 #-} +instance Index ix => Shape DW ix where + maxLinearSize = Just . SafeSz . elemsCount + {-# INLINE maxLinearSize #-} -instance Load DW Ix1 e where + +instance Size DW where size = dSize . dwArray {-# INLINE size #-} - getComp = dComp . dwArray - {-# INLINE getComp #-} + +instance Load DW Ix1 e where loadArrayM scheduler arr uWrite = do (loadWindow, wStart, wEnd) <- loadWithIx1 (scheduleWork scheduler) arr uWrite let (chunkWidth, slackWidth) = (wEnd - wStart) `quotRem` numWorkers scheduler @@ -335,10 +342,6 @@ loadWindowIx2 nWorkers loadWindow (it :. ib) = do instance Load DW Ix2 e where - size = dSize . dwArray - {-# INLINE size #-} - getComp = dComp . dwArray - {-# INLINE getComp #-} loadArrayM scheduler arr uWrite = loadWithIx2 (scheduleWork scheduler) arr uWrite >>= uncurry (loadWindowIx2 (numWorkers scheduler)) @@ -352,10 +355,6 @@ instance StrideLoad DW Ix2 e where instance (Index (IxN n), Load DW (Ix (n - 1)) e) => Load DW (IxN n) e where - size = dSize . dwArray - {-# INLINE size #-} - getComp = dComp . dwArray - {-# INLINE getComp #-} loadArrayM = loadWithIxN {-# INLINE loadArrayM #-} @@ -479,79 +478,3 @@ unrollAndJam !bH (it :. jt) (ib :. jb) js f = do -- TODO: Implement Hilbert curve - -toIx2Window :: Window Ix2T e -> Window Ix2 e -toIx2Window Window {..} = - Window - { windowStart = toIx2 windowStart - , windowSize = SafeSz (toIx2 $ unSz windowSize) - , windowIndex = windowIndex . fromIx2 - , windowUnrollIx2 = windowUnrollIx2 - } -{-# INLINE toIx2Window #-} - -toIx2ArrayDW :: Array DW Ix2T e -> Array DW Ix2 e -toIx2ArrayDW DWArray {dwArray, dwWindow} = - DWArray - { dwArray = - dwArray {dIndex = dIndex dwArray . fromIx2, dSize = SafeSz (toIx2 (unSz (dSize dwArray)))} - , dwWindow = fmap toIx2Window dwWindow - } -{-# INLINE toIx2ArrayDW #-} - - -instance Load DW Ix2T e where - size = dSize . dwArray - {-# INLINE size #-} - getComp = dComp . dwArray - {-# INLINE getComp #-} - loadArrayM scheduler arr = - loadArrayWithStrideM scheduler oneStride (size arr) arr - {-# INLINE loadArrayM #-} - -instance StrideLoad DW Ix2T e where - loadArrayWithStrideM scheduler stride sz arr = - loadArrayWithStrideM - scheduler - (Stride $ toIx2 $ unStride stride) - (SafeSz (toIx2 (unSz sz))) - (toIx2ArrayDW arr) - {-# INLINE loadArrayWithStrideM #-} - -instance Load DW Ix3T e where - size = dSize . dwArray - {-# INLINE size #-} - getComp = dComp . dwArray - {-# INLINE getComp #-} - loadArrayM scheduler arr = - loadArrayWithStrideM scheduler oneStride (size arr) arr - {-# INLINE loadArrayM #-} - -instance StrideLoad DW Ix3T e where - loadArrayWithStrideM = loadArrayWithIxN - {-# INLINE loadArrayWithStrideM #-} - - -instance Load DW Ix4T e where - size = dSize . dwArray - {-# INLINE size #-} - getComp = dComp . dwArray - {-# INLINE getComp #-} - loadArrayM scheduler arr = loadArrayWithStrideM scheduler oneStride (size arr) arr - {-# INLINE loadArrayM #-} - -instance StrideLoad DW Ix4T e where - loadArrayWithStrideM = loadArrayWithIxN - {-# INLINE loadArrayWithStrideM #-} - - -instance Load DW Ix5T e where - size = dSize . dwArray - {-# INLINE size #-} - getComp = dComp . dwArray - {-# INLINE getComp #-} - loadArrayM scheduler arr = loadArrayWithStrideM scheduler oneStride (size arr) arr - {-# INLINE loadArrayM #-} -instance StrideLoad DW Ix5T e where - loadArrayWithStrideM = loadArrayWithIxN - {-# INLINE loadArrayWithStrideM #-} diff --git a/massiv/src/Data/Massiv/Array/Manifest.hs b/massiv/src/Data/Massiv/Array/Manifest.hs index cbae46dc..0add0d0a 100644 --- a/massiv/src/Data/Massiv/Array/Manifest.hs +++ b/massiv/src/Data/Massiv/Array/Manifest.hs @@ -154,7 +154,7 @@ toByteString = castToByteString . -- | /O(n)/ - Conversion of array monoidally into a ByteString `Builder`. -- -- @since 0.2.1 -toBuilder :: Source r ix e => (e -> Builder) -> Array r ix e -> Builder +toBuilder :: (Index ix, Source r e) => (e -> Builder) -> Array r ix e -> Builder toBuilder = foldMono {-# INLINE toBuilder #-} @@ -193,7 +193,7 @@ castFromByteString comp (PS fp offset len) = unsafeArrayFromForeignPtr comp fp o -- after it was applyied to all elements of the array. -- -- @since 0.5.5 -findIndex :: Manifest r ix e => (e -> Bool) -> Array r ix e -> Maybe ix +findIndex :: (Index ix, Manifest r e) => (e -> Bool) -> Array r ix e -> Maybe ix findIndex f arr = go 0 where !sz = size arr @@ -211,7 +211,7 @@ findIndex f arr = go 0 -- programs. -- -- @since 0.5.9 -mallocCompute :: forall r ix e. (Source r ix e, Storable e) => Array r ix e -> IO (Array S ix e) +mallocCompute :: forall r ix e. (Size r, Load r ix e, Storable e) => Array r ix e -> IO (Array S ix e) mallocCompute arr = do let sz = size arr marr <- unsafeMallocMArray sz diff --git a/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs b/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs index 13bb83e7..a451477a 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs @@ -129,9 +129,14 @@ instance (Index ix, Ord e) => Ord (Array BL ix e) where compare = compareArrays compare {-# INLINE compare #-} -instance Index ix => Construct BL ix e where +instance Strategy BL where setComp c arr = arr { blComp = c } {-# INLINE setComp #-} + getComp = blComp + {-# INLINE getComp #-} + + +instance Index ix => Construct BL ix e where makeArrayLinear !comp !sz f = unsafePerformIO $ generateArrayLinear comp sz (pure . f) {-# INLINE makeArrayLinear #-} @@ -139,7 +144,7 @@ instance Index ix => Construct BL ix e where replicate comp sz e = runST (newMArray sz e >>= unsafeFreeze comp) {-# INLINE replicate #-} -instance Index ix => Source BL ix e where +instance Source BL e where unsafeLinearIndex (BLArray _ _sz o a) i = INDEX_CHECK("(Source BL ix e).unsafeLinearIndex", SafeSz . sizeofArray, A.indexArray) a (i + o) @@ -149,7 +154,7 @@ instance Index ix => Source BL ix e where {-# INLINE unsafeLinearSlice #-} -instance Index ix => Resize BL ix where +instance Resize BL where unsafeResize !sz !arr = arr { blSize = sz } {-# INLINE unsafeResize #-} @@ -181,7 +186,7 @@ instance {-# OVERLAPPING #-} Slice BL Ix1 e where {-# INLINE unsafeSlice #-} -instance Index ix => Manifest BL ix e where +instance Manifest BL e where unsafeLinearIndexM (BLArray _ _sz o a) i = INDEX_CHECK("(Manifest BL ix e).unsafeLinearIndexM", @@ -189,12 +194,15 @@ instance Index ix => Manifest BL ix e where {-# INLINE unsafeLinearIndexM #-} -instance Index ix => Mutable BL ix e where +instance Mutable BL e where data MArray s BL ix e = MBLArray !(Sz ix) {-# UNPACK #-} !Int {-# UNPACK #-} !(A.MutableArray s e) msize (MBLArray sz _ _) = sz {-# INLINE msize #-} + munsafeResize sz (MBLArray _ off marr) = MBLArray sz off marr + {-# INLINE munsafeResize #-} + unsafeThaw (BLArray _ sz o a) = MBLArray sz o <$> A.unsafeThawArray a {-# INLINE unsafeThaw #-} @@ -220,12 +228,16 @@ instance Index ix => Mutable BL ix e where SafeSz . sizeofMutableArray, A.writeArray) ma (i + o) e {-# INLINE unsafeLinearWrite #-} -instance Index ix => Load BL ix e where - type R BL = M +instance Size BL where size = blSize {-# INLINE size #-} - getComp = blComp - {-# INLINE getComp #-} + +instance Index ix => Shape BL ix where + maxLinearSize = Just . SafeSz . elemsCount + {-# INLINE maxLinearSize #-} + +instance Index ix => Load BL ix e where + type R BL = M loadArrayM !scheduler !arr = splitLinearlyWith_ scheduler (elemsCount arr) (unsafeLinearIndex arr) {-# INLINE loadArrayM #-} @@ -324,27 +336,38 @@ instance (Index ix, Ord e) => Ord (Array B ix e) where compare = compareArrays compare {-# INLINE compare #-} -instance Index ix => Construct B ix e where - setComp c = coerce (\arr -> arr { blComp = c }) - {-# INLINE setComp #-} +instance Index ix => Construct B ix e where makeArrayLinear !comp !sz f = unsafePerformIO $ generateArrayLinear comp sz (pure . f) {-# INLINE makeArrayLinear #-} replicate comp sz e = runST (newMArray sz e >>= unsafeFreeze comp) {-# INLINE replicate #-} -instance Index ix => Source B ix e where - unsafeLinearIndex arr = unsafeLinearIndex (coerce arr :: Array BL ix e) +instance Source B e where + unsafeLinearIndex arr = unsafeLinearIndex (toLazyArray arr) {-# INLINE unsafeLinearIndex #-} - unsafeLinearSlice i k arr = coerce (unsafeLinearSlice i k (coerce arr :: Array BL ix e)) + unsafeLinearSlice i k arr = coerce (unsafeLinearSlice i k (toLazyArray arr)) {-# INLINE unsafeLinearSlice #-} +instance Strategy B where + getComp = blComp . coerce + {-# INLINE getComp #-} + setComp c arr = coerceBoxedArray (coerce arr) { blComp = c } + {-# INLINE setComp #-} -instance Index ix => Resize B ix where + +instance Resize B where unsafeResize sz = coerce (\arr -> arr { blSize = sz }) - {-# INLINE unsafeResize #-} + +instance Index ix => Shape B ix where + maxLinearSize = Just . SafeSz . elemsCount + {-# INLINE maxLinearSize #-} + +instance Size B where + size = blSize . coerce + {-# INLINE size #-} instance Index ix => Extract B ix e where unsafeExtract !sIx !newSz !arr = unsafeExtract sIx newSz (toManifest arr) @@ -374,18 +397,21 @@ instance {-# OVERLAPPING #-} Slice B Ix1 e where {-# INLINE unsafeSlice #-} -instance Index ix => Manifest B ix e where +instance Manifest B e where unsafeLinearIndexM = coerce unsafeLinearIndexM {-# INLINE unsafeLinearIndexM #-} -instance Index ix => Mutable B ix e where +instance Mutable B e where newtype MArray s B ix e = MBArray (MArray s BL ix e) msize = msize . coerce {-# INLINE msize #-} + munsafeResize sz = MBArray . munsafeResize sz . coerce + {-# INLINE munsafeResize #-} + unsafeThaw arr = MBArray <$> unsafeThaw (coerce arr) {-# INLINE unsafeThaw #-} @@ -409,10 +435,6 @@ instance Index ix => Mutable B ix e where instance Index ix => Load B ix e where type R B = M - size = blSize . coerce - {-# INLINE size #-} - getComp = blComp . coerce - {-# INLINE getComp #-} loadArrayM scheduler = coerce (loadArrayM scheduler) {-# INLINE loadArrayM #-} @@ -499,10 +521,10 @@ pattern N :: N pattern N = BN {-# COMPLETE N #-} -newtype instance Array N ix e = BNArray { bArray :: Array BL ix e } +newtype instance Array BN ix e = BNArray (Array BL ix e) instance (Ragged L ix e, Show e, NFData e) => Show (Array BN ix e) where - showsPrec = showsArrayPrec bArray + showsPrec = showsArrayPrec coerce showList = showArrayList -- | /O(1)/ - `BN` is already in normal form @@ -518,24 +540,35 @@ instance (Index ix, NFData e, Ord e) => Ord (Array BN ix e) where compare = compareArrays compare {-# INLINE compare #-} +instance Strategy N where + setComp c = coerce (setComp c) + {-# INLINE setComp #-} + getComp = blComp . coerce + {-# INLINE getComp #-} instance (Index ix, NFData e) => Construct BN ix e where - setComp c (BNArray arr) = BNArray (arr {blComp = c}) - {-# INLINE setComp #-} makeArrayLinear !comp !sz f = unsafePerformIO $ generateArrayLinear comp sz (pure . f) {-# INLINE makeArrayLinear #-} replicate comp sz e = runST (newMArray sz e >>= unsafeFreeze comp) {-# INLINE replicate #-} -instance (Index ix, NFData e) => Source BN ix e where +instance NFData e => Source BN e where unsafeLinearIndex (BNArray arr) = unsafeLinearIndex arr {-# INLINE unsafeLinearIndex #-} unsafeLinearSlice i k (BNArray a) = BNArray $ unsafeLinearSlice i k a {-# INLINE unsafeLinearSlice #-} -instance Index ix => Resize BN ix where - unsafeResize !sz = BNArray . unsafeResize sz . bArray +instance Index ix => Shape BN ix where + maxLinearSize = Just . SafeSz . elemsCount + {-# INLINE maxLinearSize #-} + +instance Size BN where + size = blSize . coerce + {-# INLINE size #-} + +instance Resize BN where + unsafeResize !sz = coerce . unsafeResize sz . coerce {-# INLINE unsafeResize #-} instance (Index ix, NFData e) => Extract BN ix e where @@ -568,18 +601,20 @@ instance {-# OVERLAPPING #-} NFData e => Slice BN Ix1 e where {-# INLINE unsafeSlice #-} -instance (Index ix, NFData e) => Manifest BN ix e where - +instance NFData e => Manifest BN e where unsafeLinearIndexM arr = unsafeLinearIndexM (coerce arr) {-# INLINE unsafeLinearIndexM #-} -instance (Index ix, NFData e) => Mutable BN ix e where +instance NFData e => Mutable BN e where newtype MArray s BN ix e = MBNArray (MArray s BL ix e) msize = msize . coerce {-# INLINE msize #-} + munsafeResize sz = coerce . munsafeResize sz . coerce + {-# INLINE munsafeResize #-} + unsafeThaw arr = MBNArray <$> unsafeThaw (coerce arr) {-# INLINE unsafeThaw #-} @@ -603,10 +638,6 @@ instance (Index ix, NFData e) => Mutable BN ix e where instance (Index ix, NFData e) => Load BN ix e where type R BN = M - size = blSize . coerce - {-# INLINE size #-} - getComp = blComp . coerce - {-# INLINE getComp #-} loadArrayM !scheduler !arr = splitLinearlyWith_ scheduler (elemsCount arr) (unsafeLinearIndex arr) {-# INLINE loadArrayM #-} diff --git a/massiv/src/Data/Massiv/Array/Manifest/Internal.hs b/massiv/src/Data/Massiv/Array/Manifest/Internal.hs index 23ed5a71..03620665 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Internal.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Internal.hs @@ -100,7 +100,7 @@ instance (Ord e, Index ix) => Ord (Array M ix e) where -- | /O(1)/ - Conversion of `Manifest` arrays to `M` representation. -toManifest :: Manifest r ix e => Array r ix e -> Array M ix e +toManifest :: (Index ix, Manifest r e) => Array r ix e -> Array M ix e toManifest !arr = MArray (getComp arr) (size arr) (unsafeLinearIndexM arr) {-# INLINE toManifest #-} @@ -129,20 +129,32 @@ instance Index ix => Foldable (Array M ix) where {-# INLINE toList #-} -instance Index ix => Source M ix e where +instance Strategy M where + getComp = mComp + {-# INLINE getComp #-} + setComp comp arr = arr {mComp = comp} + {-# INLINE setComp #-} + + +instance Source M e where unsafeLinearIndex = mLinearIndex {-# INLINE unsafeLinearIndex #-} unsafeLinearSlice ix sz arr = unsafeExtract ix sz (unsafeResize sz arr) {-# INLINE unsafeLinearSlice #-} -instance Index ix => Manifest M ix e where +instance Manifest M e where unsafeLinearIndexM = mLinearIndex {-# INLINE unsafeLinearIndexM #-} +instance Index ix => Shape M ix -instance Index ix => Resize M ix where +instance Size M where + size = mSize + {-# INLINE size #-} + +instance Resize M where unsafeResize !sz !arr = arr { mSize = sz } {-# INLINE unsafeResize #-} @@ -192,10 +204,6 @@ instance (Elt M ix e ~ Array M (Lower ix) e, Index ix, Index (Lower ix)) => Inne instance Index ix => Load M ix e where - size = mSize - {-# INLINE size #-} - getComp = mComp - {-# INLINE getComp #-} loadArrayM scheduler (MArray _ sz f) = splitLinearlyWith_ scheduler (totalElem sz) f {-# INLINE loadArrayM #-} @@ -221,7 +229,7 @@ instance Num e => FoldNumeric M e where -- before calling @compute@ -- -- @since 0.1.0 -compute :: forall r ix e r' . (Mutable r ix e, Load r' ix e) => Array r' ix e -> Array r ix e +compute :: forall r ix e r' . (Mutable r e, Load r' ix e) => Array r' ix e -> Array r ix e compute !arr = unsafePerformIO $ computeIO arr {-# INLINE compute #-} @@ -229,7 +237,7 @@ compute !arr = unsafePerformIO $ computeIO arr -- the same as `computePrimM`, but executed in `ST`, thus pure. -- -- @since 0.1.0 -computeS :: forall r ix e r' . (Mutable r ix e, Load r' ix e) => Array r' ix e -> Array r ix e +computeS :: forall r ix e r' . (Mutable r e, Load r' ix e) => Array r' ix e -> Array r ix e computeS !arr = runST $ computePrimM arr {-# INLINE computeS #-} @@ -240,7 +248,7 @@ computeS !arr = runST $ computePrimM arr -- -- @since 0.5.4 computeP :: - forall r ix e r'. (Mutable r ix e, Construct r' ix e, Load r' ix e) + forall r ix e r'. (Mutable r e, Construct r' ix e) => Array r' ix e -> Array r ix e computeP arr = setComp (getComp arr) $ compute (setComp Par arr) @@ -253,7 +261,7 @@ computeP arr = setComp (getComp arr) $ compute (setComp Par arr) -- -- @since 0.4.5 computeIO :: - forall r ix e r' m. (Mutable r ix e, Load r' ix e, MonadIO m) + forall r ix e r' m. (Mutable r e, Load r' ix e, MonadIO m) => Array r' ix e -> m (Array r ix e) computeIO arr = liftIO (loadArray arr >>= unsafeFreeze (getComp arr)) @@ -264,7 +272,7 @@ computeIO arr = liftIO (loadArray arr >>= unsafeFreeze (getComp arr)) -- -- @since 0.4.5 computePrimM :: - forall r ix e r' m. (Mutable r ix e, Load r' ix e, PrimMonad m) + forall r ix e r' m. (Mutable r e, Load r' ix e, PrimMonad m) => Array r' ix e -> m (Array r ix e) computePrimM arr = loadArrayS arr >>= unsafeFreeze (getComp arr) @@ -280,7 +288,7 @@ computePrimM arr = loadArrayS arr >>= unsafeFreeze (getComp arr) -- Array P Seq (Sz1 10) -- [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9 ] -- -computeAs :: (Mutable r ix e, Load r' ix e) => r -> Array r' ix e -> Array r ix e +computeAs :: (Mutable r e, Load r' ix e) => r -> Array r' ix e -> Array r ix e computeAs _ = compute {-# INLINE computeAs #-} @@ -300,7 +308,7 @@ computeAs _ = compute -- [ 0, 1, 4, 9, 16, 25, 36, 49, 64, 81 ] -- -- @since 0.1.1 -computeProxy :: (Mutable r ix e, Load r' ix e) => proxy r -> Array r' ix e -> Array r ix e +computeProxy :: (Mutable r e, Load r' ix e) => proxy r -> Array r' ix e -> Array r ix e computeProxy _ = compute {-# INLINE computeProxy #-} @@ -309,7 +317,7 @@ computeProxy _ = compute -- resulting type is the same as the input. -- -- @since 0.1.0 -computeSource :: forall r ix e r' . (Mutable r ix e, Source r' ix e) +computeSource :: forall r ix e r' . (Mutable r e, Load r' ix e, Source r' e) => Array r' ix e -> Array r ix e computeSource arr = maybe (compute arr) (\Refl -> arr) (eqT :: Maybe (r' :~: r)) {-# INLINE computeSource #-} @@ -318,7 +326,7 @@ computeSource arr = maybe (compute arr) (\Refl -> arr) (eqT :: Maybe (r' :~: r)) -- | /O(n)/ - Make an exact immutable copy of an Array. -- -- @since 0.1.0 -clone :: Mutable r ix e => Array r ix e -> Array r ix e +clone :: (Mutable r e, Index ix) => Array r ix e -> Array r ix e clone arr = unsafePerformIO $ thaw arr >>= unsafeFreeze (getComp arr) {-# INLINE clone #-} @@ -333,7 +341,7 @@ gcastArr arr = fmap (\Refl -> arr) (eqT :: Maybe (r :~: r')) -- result arrays are of the same representation, in which case it is an /O(1)/ operation. -- -- @since 0.1.0 -convert :: forall r ix e r' . (Mutable r ix e, Load r' ix e) +convert :: forall r ix e r' . (Mutable r e, Load r' ix e) => Array r' ix e -> Array r ix e convert arr = fromMaybe (compute arr) (gcastArr arr) {-# INLINE convert #-} @@ -341,7 +349,7 @@ convert arr = fromMaybe (compute arr) (gcastArr arr) -- | Same as `convert`, but let's you supply resulting representation type as an argument. -- -- @since 0.1.0 -convertAs :: (Mutable r ix e, Load r' ix e) +convertAs :: (Mutable r e, Load r' ix e) => r -> Array r' ix e -> Array r ix e convertAs _ = convert {-# INLINE convertAs #-} @@ -351,7 +359,7 @@ convertAs _ = convert -- proxy argument. -- -- @since 0.1.1 -convertProxy :: (Mutable r ix e, Load r' ix e) +convertProxy :: (Mutable r e, Load r' ix e) => proxy r -> Array r' ix e -> Array r ix e convertProxy _ = convert {-# INLINE convertProxy #-} @@ -362,11 +370,11 @@ convertProxy _ = convert -- -- @since 0.4.0 fromRaggedArrayM :: - forall r ix e r' m . (Mutable r ix e, Ragged r' ix e, Load r' ix e, MonadThrow m) + forall r ix e r' m . (Mutable r e, Ragged r' ix e, MonadThrow m) => Array r' ix e -> m (Array r ix e) fromRaggedArrayM arr = - let sz = edgeSize arr + let sz = outerSize arr in either (\(e :: ShapeException) -> throwM e) pure $ unsafePerformIO $ do marr <- unsafeNew sz @@ -381,7 +389,7 @@ fromRaggedArrayM arr = -- -- @since 0.1.1 fromRaggedArray' :: - forall r ix e r'. (Mutable r ix e, Load r' ix e, Ragged r' ix e) + forall r ix e r'. (Mutable r e, Ragged r' ix e) => Array r' ix e -> Array r ix e fromRaggedArray' arr = either throw id $ fromRaggedArrayM arr @@ -390,12 +398,12 @@ fromRaggedArray' arr = either throw id $ fromRaggedArrayM arr -- | Same as `compute`, but with `Stride`. -- --- /O(n div k)/ - Where @n@ is numer of elements in the source array and @k@ is number of +-- /O(n div k)/ - Where @n@ is number of elements in the source array and @k@ is number of -- elements in the stride. -- -- @since 0.3.0 computeWithStride :: - forall r ix e r'. (Mutable r ix e, StrideLoad r' ix e) + forall r ix e r'. (Mutable r e, StrideLoad r' ix e) => Stride ix -> Array r' ix e -> Array r ix e @@ -411,7 +419,7 @@ computeWithStride stride !arr = -- -- @since 0.3.0 computeWithStrideAs :: - (Mutable r ix e, StrideLoad r' ix e) => r -> Stride ix -> Array r' ix e -> Array r ix e + (Mutable r e, StrideLoad r' ix e) => r -> Stride ix -> Array r' ix e -> Array r ix e computeWithStrideAs _ = computeWithStride {-# INLINE computeWithStrideAs #-} @@ -454,7 +462,7 @@ computeWithStrideAs _ = computeWithStride -- -- @since 0.3.6 iterateUntil :: - (Load r' ix e, Mutable r ix e) + (Size r', Load r' ix e, Mutable r e) => (Int -> Array r ix e -> Array r ix e -> Bool) -- ^ Convergence condition. Accepts current iteration counter, array at the previous -- state and at the current state. @@ -487,7 +495,7 @@ iterateUntil convergence iteration initArr0 -- -- @since 0.3.6 iterateUntilM :: - (Load r' ix e, Mutable r ix e, PrimMonad m, MonadIO m, PrimState m ~ RealWorld) + (Size r', Load r' ix e, Mutable r e, PrimMonad m, MonadIO m, PrimState m ~ RealWorld) => (Int -> Array r ix e -> MArray (PrimState m) r ix e -> m Bool) -- ^ Convergence condition. Accepts current iteration counter, pure array at previous -- state and a mutable at the current state, therefore after each iteration its contents @@ -513,7 +521,7 @@ iterateUntilM convergence iteration initArr0 = do iterateLoop :: - (Load r' ix e, Mutable r ix e, PrimMonad m, MonadIO m, PrimState m ~ RealWorld) + (Size r', Load r' ix e, Mutable r e, PrimMonad m, MonadIO m, PrimState m ~ RealWorld) => (Int -> Array r ix e -> Comp -> MArray (PrimState m) r ix e -> m Bool) -> (Int -> Array r ix e -> Array r' ix e) -> Int diff --git a/massiv/src/Data/Massiv/Array/Manifest/List.hs b/massiv/src/Data/Massiv/Array/Manifest/List.hs index 9ed5b89e..db6304a4 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/List.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/List.hs @@ -13,8 +13,7 @@ -- Portability : non-portable -- module Data.Massiv.Array.Manifest.List - ( - -- ** List + ( -- ** List fromList , fromListsM , fromLists' @@ -36,7 +35,7 @@ import GHC.Exts (build) -- -- @since 0.1.0 fromList :: - forall r e. Mutable r Ix1 e + forall r e. Mutable r e => Comp -- ^ Computation startegy to use -> [e] -- ^ Flat list -> Array r Ix1 e @@ -81,7 +80,7 @@ fromList = fromLists' -- *** Exception: DimTooShortException: expected (Sz1 3), got (Sz1 2) -- -- @since 0.3.0 -fromListsM :: forall r ix e m . (Nested LN ix e, Ragged L ix e, Mutable r ix e, MonadThrow m) +fromListsM :: forall r ix e m . (Nested LN ix e, Ragged L ix e, Mutable r e, MonadThrow m) => Comp -> [ListItem ix e] -> m (Array r ix e) fromListsM comp = fromRaggedArrayM . setComp comp . throughNested {-# INLINE fromListsM #-} @@ -122,7 +121,7 @@ fromListsM comp = fromRaggedArrayM . setComp comp . throughNested -- Array U *** Exception: DimTooLongException -- -- @since 0.1.0 -fromLists' :: forall r ix e . (Nested LN ix e, Ragged L ix e, Mutable r ix e) +fromLists' :: forall r ix e . (Nested LN ix e, Ragged L ix e, Mutable r e) => Comp -- ^ Computation startegy to use -> [ListItem ix e] -- ^ Nested list -> Array r ix e @@ -145,7 +144,7 @@ throughNested xs = fromNested (fromNested xs :: Array LN ix e) -- [(0,0),(0,1),(0,2),(1,0),(1,1),(1,2)] -- -- @since 0.1.0 -toList :: Source r ix e => Array r ix e -> [e] +toList :: (Index ix, Source r e) => Array r ix e -> [e] toList !arr = build (\ c n -> foldrFB c n arr) {-# INLINE toList #-} @@ -171,7 +170,7 @@ toList !arr = build (\ c n -> foldrFB c n arr) -- [[[0 :> 0 :. 0,0 :> 0 :. 1,0 :> 0 :. 2]],[[1 :> 0 :. 0,1 :> 0 :. 1,1 :> 0 :. 2]]] -- -- @since 0.1.0 -toLists :: (Nested LN ix e, Construct L ix e, Source r ix e) +toLists :: (Nested LN ix e, Construct L ix e, Load r ix e, Source r e) => Array r ix e -> [ListItem ix e] toLists = toNested . toNested . toListArray @@ -191,7 +190,7 @@ toLists = toNested . toNested . toListArray -- [[(0,0,0),(0,0,1),(0,0,2)],[(1,0,0),(1,0,1),(1,0,2)]] -- -- @since 0.1.0 -toLists2 :: (Source r ix e, Index (Lower ix)) => Array r ix e -> [[e]] +toLists2 :: (Index ix, Source r e, Index (Lower ix)) => Array r ix e -> [[e]] toLists2 = toList . foldrInner (:) [] {-# INLINE toLists2 #-} @@ -200,7 +199,8 @@ toLists2 = toList . foldrInner (:) [] -- get flattened. -- -- @since 0.1.0 -toLists3 :: (Index (Lower (Lower ix)), Index (Lower ix), Source r ix e) => Array r ix e -> [[[e]]] +toLists3 :: + (Index (Lower (Lower ix)), Index (Lower ix), Index ix, Source r e) => Array r ix e -> [[[e]]] toLists3 = toList . foldrInner (:) [] . foldrInner (:) [] {-# INLINE toLists3 #-} @@ -212,7 +212,8 @@ toLists4 :: ( Index (Lower (Lower (Lower ix))) , Index (Lower (Lower ix)) , Index (Lower ix) - , Source r ix e + , Index ix + , Source r e ) => Array r ix e -> [[[[e]]]] diff --git a/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs b/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs index b7a5946f..d4b4d170 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs @@ -103,17 +103,20 @@ instance (Prim e, Ord e, Index ix) => Ord (Array P ix e) where compare = compareArrays compare {-# INLINE compare #-} -instance (Prim e, Index ix) => Construct P ix e where +instance Strategy P where + getComp = pComp + {-# INLINE getComp #-} setComp c arr = arr { pComp = c } {-# INLINE setComp #-} +instance (Prim e, Index ix) => Construct P ix e where makeArrayLinear !comp !sz f = unsafePerformIO $ generateArrayLinear comp sz (pure . f) {-# INLINE makeArrayLinear #-} replicate comp !sz !e = runST (newMArray sz e >>= unsafeFreeze comp) {-# INLINE replicate #-} -instance (Prim e, Index ix) => Source P ix e where +instance Prim e => Source P e where unsafeLinearIndex _arr@(PArray _ _ o a) i = INDEX_CHECK("(Source P ix e).unsafeLinearIndex", SafeSz . elemsBA _arr, indexByteArray) a (i + o) @@ -122,8 +125,15 @@ instance (Prim e, Index ix) => Source P ix e where unsafeLinearSlice i k (PArray c _ o a) = PArray c k (i + o) a {-# INLINE unsafeLinearSlice #-} +instance Index ix => Shape P ix where + maxLinearSize = Just . SafeSz . elemsCount + {-# INLINE maxLinearSize #-} + +instance Size P where + size = pSize + {-# INLINE size #-} -instance Index ix => Resize P ix where +instance Resize P where unsafeResize !sz !arr = arr { pSize = sz } {-# INLINE unsafeResize #-} @@ -176,7 +186,7 @@ instance ( Prim e unsafeInnerSlice arr = unsafeInnerSlice (toManifest arr) {-# INLINE unsafeInnerSlice #-} -instance (Index ix, Prim e) => Manifest P ix e where +instance Prim e => Manifest P e where unsafeLinearIndexM _pa@(PArray _ _sz o a) i = INDEX_CHECK("(Manifest P ix e).unsafeLinearIndexM", @@ -184,12 +194,15 @@ instance (Index ix, Prim e) => Manifest P ix e where {-# INLINE unsafeLinearIndexM #-} -instance (Index ix, Prim e) => Mutable P ix e where +instance Prim e => Mutable P e where data MArray s P ix e = MPArray !(Sz ix) {-# UNPACK #-} !Int {-# UNPACK #-} !(MutableByteArray s) msize (MPArray sz _ _) = sz {-# INLINE msize #-} + munsafeResize sz (MPArray _ off marr) = MPArray sz off marr + {-# INLINE munsafeResize #-} + unsafeThaw (PArray _ sz o a) = MPArray sz o <$> unsafeThawByteArray a {-# INLINE unsafeThaw #-} @@ -243,10 +256,6 @@ instance (Index ix, Prim e) => Mutable P ix e where instance (Prim e, Index ix) => Load P ix e where type R P = M - size = pSize - {-# INLINE size #-} - getComp = pComp - {-# INLINE getComp #-} loadArrayM !scheduler !arr = splitLinearlyWith_ scheduler (elemsCount arr) (unsafeLinearIndex arr) {-# INLINE loadArrayM #-} diff --git a/massiv/src/Data/Massiv/Array/Manifest/Storable.hs b/massiv/src/Data/Massiv/Array/Manifest/Storable.hs index a1161813..f24475f8 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Storable.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Storable.hs @@ -91,25 +91,35 @@ instance (Storable e, Ord e, Index ix) => Ord (Array S ix e) where compare = compareArrays compare {-# INLINE compare #-} -instance (Storable e, Index ix) => Construct S ix e where +instance Strategy S where + getComp = sComp + {-# INLINE getComp #-} setComp c arr = arr { sComp = c } {-# INLINE setComp #-} +instance (Storable e, Index ix) => Construct S ix e where makeArrayLinear !comp !sz f = unsafePerformIO $ generateArrayLinear comp sz (pure . f) {-# INLINE makeArrayLinear #-} replicate comp !sz !e = runST (newMArray sz e >>= unsafeFreeze comp) {-# INLINE replicate #-} - -instance (Storable e, Index ix) => Source S ix e where +instance VS.Storable e => Source S e where unsafeLinearIndex (SArray _ _ v) = INDEX_CHECK("(Source S ix e).unsafeLinearIndex", Sz . VS.length, VS.unsafeIndex) v {-# INLINE unsafeLinearIndex #-} unsafeLinearSlice i k (SArray c _ v) = SArray c k $ VS.unsafeSlice i (unSz k) v {-# INLINE unsafeLinearSlice #-} -instance Index ix => Resize S ix where +instance Index ix => Shape S ix where + maxLinearSize = Just . SafeSz . elemsCount + {-# INLINE maxLinearSize #-} + +instance Size S where + size = sSize + {-# INLINE size #-} + +instance Resize S where unsafeResize !sz !arr = arr { sSize = sz } {-# INLINE unsafeResize #-} @@ -144,19 +154,22 @@ instance {-# OVERLAPPING #-} Storable e => Slice S Ix1 e where {-# INLINE unsafeSlice #-} -instance (Index ix, Storable e) => Manifest S ix e where +instance Storable e => Manifest S e where unsafeLinearIndexM (SArray _ _ v) = INDEX_CHECK("(Manifest S ix e).unsafeLinearIndexM", Sz . VS.length, VS.unsafeIndex) v {-# INLINE unsafeLinearIndexM #-} -instance (Index ix, Storable e) => Mutable S ix e where +instance Storable e => Mutable S e where data MArray s S ix e = MSArray !(Sz ix) !(VS.MVector s e) msize (MSArray sz _) = sz {-# INLINE msize #-} + munsafeResize sz (MSArray _ mvec) = MSArray sz mvec + {-# INLINE munsafeResize #-} + unsafeThaw (SArray _ sz v) = MSArray sz <$> VS.unsafeThaw v {-# INLINE unsafeThaw #-} @@ -217,10 +230,6 @@ instance (Index ix, Storable e) => Mutable S ix e where instance (Index ix, Storable e) => Load S ix e where type R S = M - size = sSize - {-# INLINE size #-} - getComp = sComp - {-# INLINE getComp #-} loadArrayM !scheduler !arr = splitLinearlyWith_ scheduler (elemsCount arr) (unsafeLinearIndex arr) {-# INLINE loadArrayM #-} diff --git a/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs b/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs index cd365e16..12456462 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs @@ -62,10 +62,13 @@ instance NFData ix => NFData (MArray s U ix e) where rnf (MUArray sz mv) = sz `deepseq` mv `deepseq` () {-# INLINE rnf #-} -instance (VU.Unbox e, Index ix) => Construct U ix e where +instance Strategy U where + getComp = uComp + {-# INLINE getComp #-} setComp c arr = arr { uComp = c } {-# INLINE setComp #-} +instance (VU.Unbox e, Index ix) => Construct U ix e where makeArrayLinear !comp !sz f = unsafePerformIO $ generateArrayLinear comp sz (pure . f) {-# INLINE makeArrayLinear #-} @@ -82,15 +85,22 @@ instance (VU.Unbox e, Ord e, Index ix) => Ord (Array U ix e) where {-# INLINE compare #-} -instance (VU.Unbox e, Index ix) => Source U ix e where +instance VU.Unbox e => Source U e where unsafeLinearIndex (UArray _ _ v) = INDEX_CHECK("(Source U ix e).unsafeLinearIndex", Sz . VU.length, VU.unsafeIndex) v {-# INLINE unsafeLinearIndex #-} unsafeLinearSlice i k (UArray c _ v) = UArray c k $ VU.unsafeSlice i (unSz k) v {-# INLINE unsafeLinearSlice #-} +instance Index ix => Shape U ix where + maxLinearSize = Just . SafeSz . elemsCount + {-# INLINE maxLinearSize #-} + +instance Size U where + size = uSize + {-# INLINE size #-} -instance Index ix => Resize U ix where +instance Resize U where unsafeResize !sz !arr = arr { uSize = sz } {-# INLINE unsafeResize #-} @@ -100,10 +110,6 @@ instance (VU.Unbox e, Index ix) => Extract U ix e where instance (VU.Unbox e, Index ix) => Load U ix e where type R U = M - size = uSize - {-# INLINE size #-} - getComp = uComp - {-# INLINE getComp #-} loadArrayM !scheduler !arr = splitLinearlyWith_ scheduler (elemsCount arr) (unsafeLinearIndex arr) {-# INLINE loadArrayM #-} @@ -154,19 +160,22 @@ instance ( VU.Unbox e unsafeInnerSlice arr = unsafeInnerSlice (toManifest arr) {-# INLINE unsafeInnerSlice #-} -instance (VU.Unbox e, Index ix) => Manifest U ix e where +instance VU.Unbox e => Manifest U e where unsafeLinearIndexM (UArray _ _ v) = INDEX_CHECK("(Manifest U ix e).unsafeLinearIndexM", Sz . VU.length, VU.unsafeIndex) v {-# INLINE unsafeLinearIndexM #-} -instance (VU.Unbox e, Index ix) => Mutable U ix e where +instance VU.Unbox e => Mutable U e where data MArray s U ix e = MUArray !(Sz ix) !(VU.MVector s e) msize (MUArray sz _) = sz {-# INLINE msize #-} + munsafeResize sz (MUArray _ mvec) = MUArray sz mvec + {-# INLINE munsafeResize #-} + unsafeThaw (UArray _ sz v) = MUArray sz <$> VU.unsafeThaw v {-# INLINE unsafeThaw #-} diff --git a/massiv/src/Data/Massiv/Array/Manifest/Vector.hs b/massiv/src/Data/Massiv/Array/Manifest/Vector.hs index 68577899..375c59ee 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Vector.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Vector.hs @@ -59,7 +59,7 @@ type family VRepr r :: * -> * where -- return `Nothing` if there is a size mismatch or if some non-standard vector type is -- supplied. Is suppplied is the boxed `Data.Vector.Vector` then it's all elements will be -- evaluated toWHNF, therefore complexity will be /O(n)/ -castFromVector :: forall v r ix e. (VG.Vector v e, Typeable v, Mutable r ix e, ARepr v ~ r) +castFromVector :: forall v r ix e. (VG.Vector v e, Typeable v, Index ix, ARepr v ~ r) => Comp -> Sz ix -- ^ Size of the result Array -> v e -- ^ Source Vector @@ -90,12 +90,7 @@ castFromVector comp sz vector = do -- -- @since 0.3.0 fromVectorM :: - ( MonadThrow m - , Typeable v - , VG.Vector v a - , Mutable (ARepr v) ix a - , Mutable r ix a - ) + (MonadThrow m, Typeable v, VG.Vector v a, Mutable r a, Load (ARepr v) ix a, Construct r ix a) => Comp -> Sz ix -- ^ Resulting size of the array -> v a -- ^ Source Vector @@ -113,7 +108,7 @@ fromVectorM comp sz v = -- -- @since 0.3.0 fromVector' :: - (Typeable v, VG.Vector v a, Mutable (ARepr v) ix a, Mutable r ix a) + (Typeable v, VG.Vector v a, Load (ARepr v) ix a, Construct r ix a, Mutable r a) => Comp -> Sz ix -- ^ Resulting size of the array -> v a -- ^ Source Vector @@ -125,7 +120,7 @@ fromVector' comp sz = either throw id . fromVectorM comp sz -- return `Nothing` only if source array representation was not one of `B`, `N`, -- `P`, `S` or `U`. castToVector :: - forall v r ix e. (Mutable r ix e, VRepr r ~ v) + forall v r ix e. (Mutable r e, Index ix, VRepr r ~ v) => Array r ix e -> Maybe (v e) castToVector arr = @@ -175,8 +170,9 @@ castToVector arr = -- toVector :: forall r ix e v. - ( Manifest r ix e - , Mutable (ARepr v) ix e + ( Manifest r e + , Load r ix e + , Mutable (ARepr v) e , VG.Vector v e , VRepr (ARepr v) ~ v ) diff --git a/massiv/src/Data/Massiv/Array/Mutable.hs b/massiv/src/Data/Massiv/Array/Mutable.hs index a102b8e3..bdbc6a7d 100644 --- a/massiv/src/Data/Massiv/Array/Mutable.hs +++ b/massiv/src/Data/Massiv/Array/Mutable.hs @@ -118,7 +118,7 @@ import Prelude hiding (mapM, read) -- -- @since 0.1.0 new :: - forall r ix e m. (Mutable r ix e, PrimMonad m) + forall r ix e m. (Mutable r e, Index ix, PrimMonad m) => Sz ix -> m (MArray (PrimState m) r ix e) new = initializeNew Nothing @@ -153,7 +153,7 @@ new = initializeNew Nothing -- -- @since 0.6.0 newMArray' :: - forall r ix e m. (Mutable r ix e, PrimMonad m) + forall r ix e m. (Mutable r e, Index ix, PrimMonad m) => Sz ix -> m (MArray (PrimState m) r ix e) newMArray' sz = unsafeNew sz >>= \ma -> ma <$ initialize ma @@ -178,7 +178,7 @@ newMArray' sz = unsafeNew sz >>= \ma -> ma <$ initialize ma -- ] -- -- @since 0.1.0 -thaw :: forall r ix e m. (Mutable r ix e, MonadIO m) => Array r ix e -> m (MArray RealWorld r ix e) +thaw :: forall r ix e m. (Mutable r e, Index ix, MonadIO m) => Array r ix e -> m (MArray RealWorld r ix e) thaw arr = liftIO $ do let sz = size arr @@ -210,7 +210,7 @@ thaw arr = -- -- @since 0.3.0 thawS :: - forall r ix e m. (Mutable r ix e, PrimMonad m) + forall r ix e m. (Mutable r e, Index ix, PrimMonad m) => Array r ix e -> m (MArray (PrimState m) r ix e) thawS arr = do @@ -236,7 +236,7 @@ thawS arr = do -- -- @since 0.1.0 freeze :: - forall r ix e m. (Mutable r ix e, MonadIO m) + forall r ix e m. (Mutable r e, Index ix, MonadIO m) => Comp -> MArray RealWorld r ix e -> m (Array r ix e) @@ -262,7 +262,7 @@ freeze comp smarr = -- -- @since 0.3.0 freezeS :: - forall r ix e m. (Mutable r ix e, PrimMonad m) + forall r ix e m. (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> m (Array r ix e) freezeS smarr = do @@ -272,22 +272,20 @@ freezeS smarr = do unsafeFreeze Seq tmarr {-# INLINE freezeS #-} - -unsafeNewUninitialized :: - (Load r' ix e, Mutable r ix e, PrimMonad m) => Array r' ix e -> m (MArray (PrimState m) r ix e) -unsafeNewUninitialized !arr = unsafeNew (fromMaybe zeroSz (maxSize arr)) -{-# INLINE unsafeNewUninitialized #-} - +unsafeNewUpper :: + (Load r' ix e, Mutable r e, PrimMonad m) => Array r' ix e -> m (MArray (PrimState m) r Ix1 e) +unsafeNewUpper !arr = unsafeNew (fromMaybe zeroSz (maxLinearSize arr)) +{-# INLINE unsafeNewUpper #-} -- | Load sequentially a pure array into the newly created mutable array. -- -- @since 0.3.0 loadArrayS :: - forall r ix e r' m. (Load r' ix e, Mutable r ix e, PrimMonad m) + forall r ix e r' m. (Load r' ix e, Mutable r e, PrimMonad m) => Array r' ix e -> m (MArray (PrimState m) r ix e) loadArrayS arr = do - marr <- unsafeNewUninitialized arr + marr <- unsafeNewUpper arr unsafeLoadIntoS marr arr {-# INLINE loadArrayS #-} @@ -296,12 +294,12 @@ loadArrayS arr = do -- -- @since 0.3.0 loadArray :: - forall r ix e r' m. (Load r' ix e, Mutable r ix e, MonadIO m) + forall r ix e r' m. (Load r' ix e, Mutable r e, MonadIO m) => Array r' ix e -> m (MArray RealWorld r ix e) loadArray arr = liftIO $ do - marr <- unsafeNewUninitialized arr + marr <- unsafeNewUpper arr unsafeLoadIntoM marr arr {-# INLINE loadArray #-} @@ -312,7 +310,7 @@ loadArray arr = -- -- @since 0.1.3 computeInto :: - (Load r' ix' e, Mutable r ix e, MonadIO m) + (Size r', Load r' ix' e, Mutable r e, Index ix, MonadIO m) => MArray RealWorld r ix e -- ^ Target Array -> Array r' ix' e -- ^ Array to load -> m () @@ -329,7 +327,7 @@ computeInto !mArr !arr = -- -- @since 0.3.0 makeMArrayS :: - forall r ix e m. (Mutable r ix e, PrimMonad m) + forall r ix e m. (Mutable r e, Index ix, PrimMonad m) => Sz ix -- ^ Size of the create array -> (ix -> m e) -- ^ Element generating action -> m (MArray (PrimState m) r ix e) @@ -341,7 +339,7 @@ makeMArrayS sz f = makeMArrayLinearS sz (f . fromLinearIndex sz) -- -- @since 0.3.0 makeMArrayLinearS :: - forall r ix e m. (Mutable r ix e, PrimMonad m) + forall r ix e m. (Mutable r e, Index ix, PrimMonad m) => Sz ix -> (Int -> m e) -> m (MArray (PrimState m) r ix e) @@ -355,7 +353,7 @@ makeMArrayLinearS sz f = do -- -- @since 0.3.0 makeMArray :: - forall r ix e m. (PrimMonad m, MonadUnliftIO m, Mutable r ix e) + forall r ix e m. (PrimMonad m, MonadUnliftIO m, Mutable r e, Index ix) => Comp -> Sz ix -> (ix -> m e) @@ -368,7 +366,7 @@ makeMArray comp sz f = makeMArrayLinear comp sz (f . fromLinearIndex sz) -- -- @since 0.3.0 makeMArrayLinear :: - forall r ix e m. (PrimMonad m, MonadUnliftIO m, Mutable r ix e) + forall r ix e m. (PrimMonad m, MonadUnliftIO m, Mutable r e, Index ix) => Comp -> Sz ix -> (Int -> m e) @@ -397,7 +395,7 @@ makeMArrayLinear comp sz f = do -- @since 0.3.0 -- createArray_ :: - forall r ix e a m. (Mutable r ix e, PrimMonad m, MonadUnliftIO m) + forall r ix e a m. (Mutable r e, Index ix, PrimMonad m, MonadUnliftIO m) => Comp -- ^ Computation strategy to use after `MArray` gets frozen and onward. -> Sz ix -- ^ Size of the newly created array -> (Scheduler m () -> MArray (PrimState m) r ix e -> m a) @@ -415,7 +413,7 @@ createArray_ comp sz action = do -- @since 0.3.0 -- createArray :: - forall r ix e a m b. (Mutable r ix e, PrimMonad m, MonadUnliftIO m) + forall r ix e a m b. (Mutable r e, Index ix, PrimMonad m, MonadUnliftIO m) => Comp -- ^ Computation strategy to use after `MArray` gets frozen and onward. -> Sz ix -- ^ Size of the newly created array -> (Scheduler m a -> MArray (PrimState m) r ix e -> m b) @@ -442,7 +440,7 @@ createArray comp sz action = do -- -- @since 0.3.0 createArrayS_ :: - forall r ix e a m. (Mutable r ix e, PrimMonad m) + forall r ix e a m. (Mutable r e, Index ix, PrimMonad m) => Sz ix -- ^ Size of the newly created array -> (MArray (PrimState m) r ix e -> m a) -- ^ An action that should fill all elements of the brand new mutable array @@ -454,7 +452,7 @@ createArrayS_ sz action = snd <$> createArrayS sz action -- -- @since 0.3.0 createArrayS :: - forall r ix e a m. (Mutable r ix e, PrimMonad m) + forall r ix e a m. (Mutable r e, Index ix, PrimMonad m) => Sz ix -- ^ Size of the newly created array -> (MArray (PrimState m) r ix e -> m a) -- ^ An action that should fill all elements of the brand new mutable array @@ -470,7 +468,7 @@ createArrayS sz action = do -- -- @since 0.3.0 createArrayST_ :: - forall r ix e a. Mutable r ix e + forall r ix e a. (Mutable r e, Index ix) => Sz ix -> (forall s. MArray s r ix e -> ST s a) -> Array r ix e @@ -482,7 +480,7 @@ createArrayST_ sz action = runST $ createArrayS_ sz action -- -- @since 0.2.6 createArrayST :: - forall r ix e a. Mutable r ix e + forall r ix e a. (Mutable r e, Index ix) => Sz ix -> (forall s. MArray s r ix e -> ST s a) -> (a, Array r ix e) @@ -515,7 +513,7 @@ createArrayST sz action = runST $ createArrayS sz action -- -- @since 0.2.6 generateArrayS :: - forall r ix e m. (Mutable r ix e, PrimMonad m) + forall r ix e m. (Mutable r e, Index ix, PrimMonad m) => Sz ix -- ^ Resulting size of the array -> (ix -> m e) -- ^ Element producing generator -> m (Array r ix e) @@ -526,7 +524,7 @@ generateArrayS sz gen = generateArrayLinearS sz (gen . fromLinearIndex sz) -- -- @since 0.3.0 generateArrayLinearS :: - forall r ix e m. (Mutable r ix e, PrimMonad m) + forall r ix e m. (Mutable r e, Index ix, PrimMonad m) => Sz ix -- ^ Resulting size of the array -> (Int -> m e) -- ^ Element producing generator -> m (Array r ix e) @@ -542,7 +540,7 @@ generateArrayLinearS sz gen = do -- -- @since 0.2.6 generateArray :: - forall r ix e m. (MonadUnliftIO m, PrimMonad m, Mutable r ix e) + forall r ix e m. (MonadUnliftIO m, PrimMonad m, Mutable r e, Index ix) => Comp -> Sz ix -> (ix -> m e) @@ -555,7 +553,7 @@ generateArray comp sz f = generateArrayLinear comp sz (f . fromLinearIndex sz) -- -- @since 0.3.0 generateArrayLinear :: - forall r ix e m. (MonadUnliftIO m, PrimMonad m, Mutable r ix e) + forall r ix e m. (MonadUnliftIO m, PrimMonad m, Mutable r e, Index ix) => Comp -> Sz ix -> (Int -> m e) @@ -568,7 +566,7 @@ generateArrayLinear comp sz f = makeMArrayLinear comp sz f >>= unsafeFreeze comp -- -- @since 0.3.4 generateArrayLinearWS :: - forall r ix e s m. (Mutable r ix e, MonadUnliftIO m, PrimMonad m) + forall r ix e s m. (Mutable r e, Index ix, MonadUnliftIO m, PrimMonad m) => WorkerStates s -> Sz ix -> (Int -> s -> m e) @@ -589,7 +587,7 @@ generateArrayLinearWS states sz make = do -- -- @since 0.3.4 generateArrayWS :: - forall r ix e s m. (Mutable r ix e, MonadUnliftIO m, PrimMonad m) + forall r ix e s m. (Mutable r e, Index ix, MonadUnliftIO m, PrimMonad m) => WorkerStates s -> Sz ix -> (ix -> s -> m e) @@ -622,7 +620,7 @@ generateArrayWS states sz make = generateArrayLinearWS states sz (make . fromLin -- -- @since 0.3.0 unfoldrPrimM_ :: - forall r ix e a m. (Mutable r ix e, PrimMonad m) + forall r ix e a m. (Mutable r e, Index ix, PrimMonad m) => Sz ix -- ^ Size of the desired array -> (a -> m (e, a)) -- ^ Unfolding action -> a -- ^ Initial accumulator @@ -634,7 +632,7 @@ unfoldrPrimM_ sz gen acc0 = snd <$> unfoldrPrimM sz gen acc0 -- -- @since 0.3.0 iunfoldrPrimM_ :: - forall r ix e a m. (Mutable r ix e, PrimMonad m) + forall r ix e a m. (Mutable r e, Index ix, PrimMonad m) => Sz ix -- ^ Size of the desired array -> (a -> ix -> m (e, a)) -- ^ Unfolding action -> a -- ^ Initial accumulator @@ -647,7 +645,7 @@ iunfoldrPrimM_ sz gen acc0 = snd <$> iunfoldrPrimM sz gen acc0 -- -- @since 0.3.0 iunfoldrPrimM :: - forall r ix e a m. (Mutable r ix e, PrimMonad m) + forall r ix e a m. (Mutable r e, Index ix, PrimMonad m) => Sz ix -- ^ Size of the desired array -> (a -> ix -> m (e, a)) -- ^ Unfolding action -> a -- ^ Initial accumulator @@ -665,7 +663,7 @@ iunfoldrPrimM sz gen acc0 = -- -- @since 0.3.0 unfoldrPrimM :: - forall r ix e a m. (Mutable r ix e, PrimMonad m) + forall r ix e a m. (Mutable r e, Index ix, PrimMonad m) => Sz ix -- ^ Size of the desired array -> (a -> m (e, a)) -- ^ Unfolding action -> a -- ^ Initial accumulator @@ -703,7 +701,7 @@ unfoldrPrimM sz gen acc0 = -- -- @since 0.3.0 unfoldlPrimM_ :: - forall r ix e a m. (Mutable r ix e, PrimMonad m) + forall r ix e a m. (Mutable r e, Index ix, PrimMonad m) => Sz ix -- ^ Size of the desired array -> (a -> m (a, e)) -- ^ Unfolding action -> a -- ^ Initial accumulator @@ -715,7 +713,7 @@ unfoldlPrimM_ sz gen acc0 = snd <$> unfoldlPrimM sz gen acc0 -- -- @since 0.3.0 iunfoldlPrimM_ :: - forall r ix e a m. (Mutable r ix e, PrimMonad m) + forall r ix e a m. (Mutable r e, Index ix, PrimMonad m) => Sz ix -- ^ Size of the desired array -> (a -> ix -> m (a, e)) -- ^ Unfolding action -> a -- ^ Initial accumulator @@ -728,7 +726,7 @@ iunfoldlPrimM_ sz gen acc0 = snd <$> iunfoldlPrimM sz gen acc0 -- -- @since 0.3.0 iunfoldlPrimM :: - forall r ix e a m. (Mutable r ix e, PrimMonad m) + forall r ix e a m. (Mutable r e, Index ix, PrimMonad m) => Sz ix -- ^ Size of the desired array -> (a -> ix -> m (a, e)) -- ^ Unfolding action -> a -- ^ Initial accumulator @@ -746,7 +744,7 @@ iunfoldlPrimM sz gen acc0 = -- -- @since 0.3.0 unfoldlPrimM :: - forall r ix e a m. (Mutable r ix e, PrimMonad m) + forall r ix e a m. (Mutable r e, Index ix, PrimMonad m) => Sz ix -- ^ Size of the desired array -> (a -> m (a, e)) -- ^ Unfolding action -> a -- ^ Initial accumulator @@ -764,7 +762,7 @@ unfoldlPrimM sz gen acc0 = -- action to it. There is no mutation to the array, unless the action itself modifies it. -- -- @since 0.4.0 -forPrimM_ :: (Mutable r ix e, PrimMonad m) => MArray (PrimState m) r ix e -> (e -> m ()) -> m () +forPrimM_ :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (e -> m ()) -> m () forPrimM_ marr f = loopM_ 0 (< totalElem (msize marr)) (+1) (unsafeLinearRead marr >=> f) {-# INLINE forPrimM_ #-} @@ -772,7 +770,7 @@ forPrimM_ marr f = -- | Sequentially loop over a mutable array while modifying each element with an action. -- -- @since 0.4.0 -forPrimM :: (Mutable r ix e, PrimMonad m) => MArray (PrimState m) r ix e -> (e -> m e) -> m () +forPrimM :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (e -> m e) -> m () forPrimM marr f = loopM_ 0 (< totalElem (msize marr)) (+1) (unsafeLinearModify marr f) {-# INLINE forPrimM #-} @@ -784,7 +782,7 @@ forPrimM marr f = -- -- @since 0.4.0 iforPrimM_ :: - (Mutable r ix e, PrimMonad m) => MArray (PrimState m) r ix e -> (ix -> e -> m ()) -> m () + (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (ix -> e -> m ()) -> m () iforPrimM_ marr f = iforLinearPrimM_ marr (f . fromLinearIndex (msize marr)) {-# INLINE iforPrimM_ #-} @@ -792,7 +790,7 @@ iforPrimM_ marr f = iforLinearPrimM_ marr (f . fromLinearIndex (msize marr)) -- -- @since 0.4.0 iforPrimM :: - (Mutable r ix e, PrimMonad m) => MArray (PrimState m) r ix e -> (ix -> e -> m e) -> m () + (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (ix -> e -> m e) -> m () iforPrimM marr f = iforLinearPrimM marr (f . fromLinearIndex (msize marr)) {-# INLINE iforPrimM #-} @@ -803,7 +801,7 @@ iforPrimM marr f = iforLinearPrimM marr (f . fromLinearIndex (msize marr)) -- -- @since 0.4.0 iforLinearPrimM_ :: - (Mutable r ix e, PrimMonad m) => MArray (PrimState m) r ix e -> (Int -> e -> m ()) -> m () + (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (Int -> e -> m ()) -> m () iforLinearPrimM_ marr f = loopM_ 0 (< totalElem (msize marr)) (+ 1) (\i -> unsafeLinearRead marr i >>= f i) {-# INLINE iforLinearPrimM_ #-} @@ -812,7 +810,7 @@ iforLinearPrimM_ marr f = -- -- @since 0.4.0 iforLinearPrimM :: - (Mutable r ix e, PrimMonad m) => MArray (PrimState m) r ix e -> (Int -> e -> m e) -> m () + (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (Int -> e -> m e) -> m () iforLinearPrimM marr f = loopM_ 0 (< totalElem (msize marr)) (+ 1) (\i -> unsafeLinearModify marr (f i) i) {-# INLINE iforLinearPrimM #-} @@ -821,7 +819,7 @@ iforLinearPrimM marr f = -- -- @since 0.5.0 withMArray :: - (Mutable r ix e, MonadUnliftIO m) + (Mutable r e, Index ix, MonadUnliftIO m) => Array r ix e -> (Scheduler m a -> MArray RealWorld r ix e -> m b) -> m ([a], Array r ix e) @@ -845,7 +843,7 @@ withMArray arr action = do -- -- @since 0.5.0 withMArray_ :: - (Mutable r ix e, MonadUnliftIO m) + (Mutable r e, Index ix, MonadUnliftIO m) => Array r ix e -> (Scheduler m () -> MArray RealWorld r ix e -> m a) -> m (Array r ix e) @@ -860,8 +858,8 @@ withMArray_ arr action = do -- array. For that reason it will be faster if supplied array is delayed. -- -- @since 0.6.1 -withLoadMArray_ :: - forall r ix e r' m b. (Load r' ix e, Mutable r ix e, MonadUnliftIO m) +withLoadMArray_ :: --TODO: fix unsafeLoadIntoM to accept a scheduler + forall r ix e r' m b. (Size r', Load r' ix e, Mutable r e, MonadUnliftIO m) => Array r' ix e -> (Scheduler m () -> MArray RealWorld r ix e -> m b) -> m (Array r ix e) @@ -884,7 +882,7 @@ withLoadMArray_ arr action = do -- -- @since 0.5.0 withMArrayS :: - (Mutable r ix e, PrimMonad m) + (Mutable r e, Index ix, PrimMonad m) => Array r ix e -> (MArray (PrimState m) r ix e -> m a) -> m (a, Array r ix e) @@ -899,7 +897,7 @@ withMArrayS arr action = do -- -- @since 0.5.0 withMArrayS_ :: - (Mutable r ix e, PrimMonad m) + (Mutable r e, Index ix, PrimMonad m) => Array r ix e -> (MArray (PrimState m) r ix e -> m a) -> m (Array r ix e) @@ -910,8 +908,8 @@ withMArrayS_ arr action = snd <$> withMArrayS arr action -- | Same as `withMArrayS`, but will work with any loadable array. -- -- @since 0.6.1 -withLoadMArrayS :: - forall r ix e r' m a. (Load r' ix e, Mutable r ix e, PrimMonad m) +withLoadMArrayS :: --TODO: fix unsafeLoadIntoM to accept a scheduler + forall r ix e r' m a. (Size r', Load r' ix e, Mutable r e, PrimMonad m) => Array r' ix e -> (MArray (PrimState m) r ix e -> m a) -> m (a, Array r ix e) @@ -925,8 +923,8 @@ withLoadMArrayS arr action = do -- | Same as `withMArrayS_`, but will work with any loadable array. -- -- @since 0.6.1 -withLoadMArrayS_ :: - forall r ix e r' m a. (Load r' ix e, Mutable r ix e, PrimMonad m) +withLoadMArrayS_ :: --TODO: remove Size + forall r ix e r' m a. (Size r', Load r' ix e, Mutable r e, PrimMonad m) => Array r' ix e -> (MArray (PrimState m) r ix e -> m a) -> m (Array r ix e) @@ -939,7 +937,7 @@ withLoadMArrayS_ arr action = snd <$> withLoadMArrayS arr action -- -- @since 0.5.0 withMArrayST :: - Mutable r ix e + (Mutable r e, Index ix) => Array r ix e -> (forall s . MArray s r ix e -> ST s a) -> (a, Array r ix e) @@ -951,7 +949,7 @@ withMArrayST arr f = runST $ withMArrayS arr f -- -- @since 0.5.0 withMArrayST_ :: - Mutable r ix e => Array r ix e -> (forall s. MArray s r ix e -> ST s a) -> Array r ix e + (Mutable r e, Index ix) => Array r ix e -> (forall s. MArray s r ix e -> ST s a) -> Array r ix e withMArrayST_ arr f = runST $ withMArrayS_ arr f {-# INLINE withMArrayST_ #-} @@ -959,8 +957,8 @@ withMArrayST_ arr f = runST $ withMArrayS_ arr f -- | Same as `withMArrayST`, but works with any loadable array. -- -- @since 0.6.1 -withLoadMArrayST :: - forall r ix e r' a. (Load r' ix e, Mutable r ix e) +withLoadMArrayST :: --TODO: remove Size + forall r ix e r' a. (Size r', Load r' ix e, Mutable r e) => Array r' ix e -> (forall s. MArray s r ix e -> ST s a) -> (a, Array r ix e) @@ -970,8 +968,8 @@ withLoadMArrayST arr f = runST $ withLoadMArrayS arr f -- | Same as `withMArrayST_`, but works with any loadable array. -- -- @since 0.6.1 -withLoadMArrayST_ :: - forall r ix e r' a. (Load r' ix e, Mutable r ix e) +withLoadMArrayST_ :: --TODO: remove Size + forall r ix e r' a. (Size r', Load r' ix e, Mutable r e) => Array r' ix e -> (forall s. MArray s r ix e -> ST s a) -> Array r ix e @@ -982,7 +980,7 @@ withLoadMArrayST_ arr f = runST $ withLoadMArrayS_ arr f -- | /O(1)/ - Lookup an element in the mutable array. Returns `Nothing` when index is out of bounds. -- -- @since 0.1.0 -read :: (Mutable r ix e, PrimMonad m) => +read :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> m (Maybe e) read marr ix = if isSafeIndex (msize marr) ix @@ -994,7 +992,7 @@ read marr ix = -- | /O(1)/ - Same as `read`, but throws `IndexOutOfBoundsException` on an invalid index. -- -- @since 0.4.0 -readM :: (Mutable r ix e, PrimMonad m, MonadThrow m) => +readM :: (Mutable r e, Index ix, PrimMonad m, MonadThrow m) => MArray (PrimState m) r ix e -> ix -> m e readM marr ix = read marr ix >>= \case @@ -1006,7 +1004,7 @@ readM marr ix = -- | /O(1)/ - Same as `read`, but throws `IndexOutOfBoundsException` on an invalid index. -- -- @since 0.1.0 -read' :: (Mutable r ix e, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> m e +read' :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> m e read' marr ix = read marr ix >>= \case Just e -> pure e @@ -1019,7 +1017,7 @@ read' marr ix = -- of bounds. -- -- @since 0.1.0 -write :: (Mutable r ix e, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> e -> m Bool +write :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> e -> m Bool write marr ix e = if isSafeIndex (msize marr) ix then unsafeWrite marr ix e >> pure True @@ -1032,7 +1030,7 @@ write marr ix e = -- words, just like `writeM`, but doesn't throw an exception. -- -- @since 0.4.4 -write_ :: (Mutable r ix e, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> e -> m () +write_ :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> e -> m () write_ marr ix = when (isSafeIndex (msize marr) ix) . unsafeWrite marr ix {-# INLINE write_ #-} @@ -1040,7 +1038,7 @@ write_ marr ix = when (isSafeIndex (msize marr) ix) . unsafeWrite marr ix -- -- @since 0.4.0 writeM :: - (Mutable r ix e, PrimMonad m, MonadThrow m) => MArray (PrimState m) r ix e -> ix -> e -> m () + (Mutable r e, Index ix, PrimMonad m, MonadThrow m) => MArray (PrimState m) r ix e -> ix -> e -> m () writeM marr ix e = write marr ix e >>= (`unless` throwM (IndexOutOfBoundsException (msize marr) ix)) {-# INLINE writeM #-} @@ -1051,7 +1049,7 @@ writeM marr ix e = -- -- @since 0.1.0 write' :: - (Mutable r ix e, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> e -> m () + (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> e -> m () write' marr ix e = write marr ix e >>= (`unless` throw (IndexOutOfBoundsException (msize marr) ix)) {-# INLINE write' #-} {-# DEPRECATED write' "In favor of more general `writeM`" #-} @@ -1061,7 +1059,7 @@ write' marr ix e = write marr ix e >>= (`unless` throw (IndexOutOfBoundsExceptio -- -- @since 0.1.0 modify :: - (Mutable r ix e, PrimMonad m) + (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -- ^ Array to mutate. -> (e -> m e) -- ^ Monadic action that modifies the element -> ix -- ^ Index at which to perform modification. @@ -1078,7 +1076,7 @@ modify marr f ix = -- -- @since 0.4.4 modify_ :: - (Mutable r ix e, PrimMonad m) + (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -- ^ Array to mutate. -> (e -> m e) -- ^ Monadic action that modifies the element -> ix -- ^ Index at which to perform modification. @@ -1092,7 +1090,7 @@ modify_ marr f ix = when (isSafeIndex (msize marr) ix) $ void $ unsafeModify mar -- -- @since 0.4.0 modifyM :: - (Mutable r ix e, PrimMonad m, MonadThrow m) + (Mutable r e, Index ix, PrimMonad m, MonadThrow m) => MArray (PrimState m) r ix e -- ^ Array to mutate. -> (e -> m e) -- ^ Monadic action that modifies the element -> ix -- ^ Index at which to perform modification. @@ -1115,7 +1113,7 @@ modifyM marr f ix -- -- @since 0.4.0 modifyM_ :: - (Mutable r ix e, PrimMonad m, MonadThrow m) + (Mutable r e, Index ix, PrimMonad m, MonadThrow m) => MArray (PrimState m) r ix e -- ^ Array to mutate. -> (e -> m e) -- ^ Monadic action that modifies the element -> ix -- ^ Index at which to perform modification. @@ -1127,7 +1125,7 @@ modifyM_ marr f ix = void $ modifyM marr f ix -- | /O(1)/ - Same as `modify`, but throws an error if index is out of bounds. -- -- @since 0.1.0 -modify' :: (Mutable r ix e, PrimMonad m) => +modify' :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (e -> e) -> ix -> m () modify' marr f ix = modify marr (pure . f) ix >>= \case @@ -1142,7 +1140,7 @@ modify' marr f ix = -- otherwise. -- -- @since 0.1.0 -swap :: (Mutable r ix e, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> ix -> m (Maybe (e, e)) +swap :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> ix -> m (Maybe (e, e)) swap marr ix1 ix2 = let !sz = msize marr in if isSafeIndex sz ix1 && isSafeIndex sz ix2 @@ -1155,7 +1153,7 @@ swap marr ix1 ix2 = -- words, it is similar to `swapM_`, but does not throw any exceptions. -- -- @since 0.4.4 -swap_ :: (Mutable r ix e, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> ix -> m () +swap_ :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> ix -> m () swap_ marr ix1 ix2 = let !sz = msize marr in when (isSafeIndex sz ix1 && isSafeIndex sz ix2) $ void $ unsafeSwap marr ix1 ix2 @@ -1167,7 +1165,7 @@ swap_ marr ix1 ix2 = -- -- @since 0.4.0 swapM :: - (Mutable r ix e, PrimMonad m, MonadThrow m) + (Mutable r e, Index ix, PrimMonad m, MonadThrow m) => MArray (PrimState m) r ix e -> ix -- ^ Index for the first element, which will be returned as the first element in the -- tuple. @@ -1187,7 +1185,7 @@ swapM marr ix1 ix2 -- -- @since 0.4.0 swapM_ :: - (Mutable r ix e, PrimMonad m, MonadThrow m) => MArray (PrimState m) r ix e -> ix -> ix -> m () + (Mutable r e, Index ix, PrimMonad m, MonadThrow m) => MArray (PrimState m) r ix e -> ix -> ix -> m () swapM_ marr ix1 ix2 = void $ swapM marr ix1 ix2 {-# INLINE swapM_ #-} @@ -1196,7 +1194,7 @@ swapM_ marr ix1 ix2 = void $ swapM marr ix1 ix2 -- -- @since 0.1.0 swap' :: - (Mutable r ix e, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> ix -> m () + (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> ix -> m () swap' marr ix1 ix2 = swap marr ix1 ix2 >>= \case Just _ -> pure () diff --git a/massiv/src/Data/Massiv/Array/Mutable/Algorithms.hs b/massiv/src/Data/Massiv/Array/Mutable/Algorithms.hs index a0994869..6cc4ce20 100644 --- a/massiv/src/Data/Massiv/Array/Mutable/Algorithms.hs +++ b/massiv/src/Data/Massiv/Array/Mutable/Algorithms.hs @@ -28,16 +28,16 @@ import Data.Massiv.Core.Common -- >>> import Data.Massiv.Array.Mutable.Algorithms -- >>> :set -XOverloadedLists -- >>> m <- thaw ([2,1,50,10,20,8] :: Array P Ix1 Int) --- >>> unstablePartitionM m (<= 10) +-- >>> unstablePartitionM m (pure . (<= 10)) -- 4 -- >>> freeze Seq m -- Array P Seq (Sz1 6) -- [ 2, 1, 8, 10, 20, 50 ] -- --- @since 0.3.2 +-- @since 1.0.0 unstablePartitionM :: - forall r e m. (Mutable r Ix1 e, PrimMonad m) + forall r e m. (Mutable r e, PrimMonad m) => MVector (PrimState m) r e - -> (e -> Bool) -- ^ Predicate + -> (e -> m Bool) -- ^ Predicate -> m Ix1 unstablePartitionM marr f = unsafeUnstablePartitionRegionM marr f 0 (unSz (msize marr) - 1) diff --git a/massiv/src/Data/Massiv/Array/Mutable/Internal.hs b/massiv/src/Data/Massiv/Array/Mutable/Internal.hs index b3e1ce72..b7912b7a 100644 --- a/massiv/src/Data/Massiv/Array/Mutable/Internal.hs +++ b/massiv/src/Data/Massiv/Array/Mutable/Internal.hs @@ -21,7 +21,7 @@ import Data.Massiv.Core.Common -- -- @since 0.5.0 unsafeCreateArrayS :: - forall r ix e a m. (Mutable r ix e, PrimMonad m) + forall r ix e a m. (Mutable r e, Index ix, PrimMonad m) => Sz ix -- ^ Size of the newly created array -> (MArray (PrimState m) r ix e -> m a) -- ^ An action that should fill all elements of the brand new mutable array @@ -38,7 +38,7 @@ unsafeCreateArrayS sz action = do -- -- @since 0.5.0 unsafeCreateArray :: - forall r ix e a m b. (Mutable r ix e, PrimMonad m, MonadUnliftIO m) + forall r ix e a m b. (Mutable r e, Index ix, PrimMonad m, MonadUnliftIO m) => Comp -- ^ Computation strategy to use after `MArray` gets frozen and onward. -> Sz ix -- ^ Size of the newly created array -> (Scheduler m a -> MArray (PrimState m) r ix e -> m b) @@ -56,7 +56,7 @@ unsafeCreateArray comp sz action = do -- -- @since 0.5.0 unsafeCreateArray_ :: - forall r ix e a m b. (Mutable r ix e, PrimMonad m, MonadUnliftIO m) + forall r ix e a m b. (Mutable r e, Index ix, PrimMonad m, MonadUnliftIO m) => Comp -- ^ Computation strategy to use after `MArray` gets frozen and onward. -> Sz ix -- ^ Size of the newly created array -> (Scheduler m a -> MArray (PrimState m) r ix e -> m b) diff --git a/massiv/src/Data/Massiv/Array/Numeric.hs b/massiv/src/Data/Massiv/Array/Numeric.hs index 50594efd..ffb466be 100644 --- a/massiv/src/Data/Massiv/Array/Numeric.hs +++ b/massiv/src/Data/Massiv/Array/Numeric.hs @@ -117,7 +117,7 @@ infixl 7 !*!, .*., .*, *., !/!, ./., ./, /., `quotA`, `remA`, `divA`, `modA` infixl 6 !+!, .+., .+, +., !-!, .-., .-, -. liftArray2M :: - (Load r ix e, Numeric r e, MonadThrow m) + (Index ix, Numeric r e, MonadThrow m) => (e -> e -> e) -> Array r ix e -> Array r ix e @@ -129,7 +129,7 @@ liftArray2M f a1 a2 liftNumericArray2M :: - (Load r ix e, MonadThrow m) + (Size r, Index ix, MonadThrow m) => (Array r ix e -> Array r ix e -> Array r ix e) -> Array r ix e -> Array r ix e @@ -146,8 +146,7 @@ liftNumericArray2M f a1 a2 -- /__Throws Exception__/: `SizeMismatchException` when array sizes do not match. -- -- @since 0.4.0 -(.+.) :: - (Load r ix e, Numeric r e, MonadThrow m) => Array r ix e -> Array r ix e -> m (Array r ix e) +(.+.) :: (Index ix, Numeric r e, MonadThrow m) => Array r ix e -> Array r ix e -> m (Array r ix e) (.+.) = liftNumericArray2M additionPointwise {-# INLINE (.+.) #-} @@ -165,7 +164,7 @@ liftNumericArray2M f a1 a2 -- [ 20, 22, 24, 26, 28, 30, 32, 34, 36, 38, 40 ] -- -- @since 0.5.6 -(!+!) :: (Load r ix e, Numeric r e) => Array r ix e -> Array r ix e -> Array r ix e +(!+!) :: (Index ix, Numeric r e) => Array r ix e -> Array r ix e -> Array r ix e (!+!) a1 a2 = throwEither (a1 .+. a2) {-# INLINE (!+!) #-} @@ -190,7 +189,7 @@ liftNumericArray2M f a1 a2 -- -- @since 0.4.0 (.-.) :: - (Load r ix e, Numeric r e, MonadThrow m) => Array r ix e -> Array r ix e -> m (Array r ix e) + (Index ix, Numeric r e, MonadThrow m) => Array r ix e -> Array r ix e -> m (Array r ix e) (.-.) = liftNumericArray2M subtractionPointwise {-# INLINE (.-.) #-} @@ -209,7 +208,7 @@ liftNumericArray2M f a1 a2 -- [ -20, -20, -20, -20, -20, -20, -20, -20, -20, -20, -20 ] -- -- @since 0.5.6 -(!-!) :: (Load r ix e, Numeric r e) => Array r ix e -> Array r ix e -> Array r ix e +(!-!) :: (Index ix, Numeric r e) => Array r ix e -> Array r ix e -> Array r ix e (!-!) a1 a2 = throwEither (a1 .-. a2) {-# INLINE (!-!) #-} @@ -235,7 +234,7 @@ liftNumericArray2M f a1 a2 -- -- @since 0.4.0 (.*.) :: - (Load r ix e, Numeric r e, MonadThrow m) => Array r ix e -> Array r ix e -> m (Array r ix e) + (Index ix, Numeric r e, MonadThrow m) => Array r ix e -> Array r ix e -> m (Array r ix e) (.*.) = liftNumericArray2M multiplicationPointwise {-# INLINE (.*.) #-} @@ -256,7 +255,7 @@ liftNumericArray2M f a1 a2 -- [ 0, 21, 44, 69, 96, 125, 156, 189, 224, 261, 300 ] -- -- @since 0.5.6 -(!*!) :: (Load r ix e, Numeric r e) => Array r ix e -> Array r ix e -> Array r ix e +(!*!) :: (Index ix, Numeric r e) => Array r ix e -> Array r ix e -> Array r ix e (!*!) a1 a2 = throwEither (a1 .*. a2) {-# INLINE (!*!) #-} @@ -320,7 +319,7 @@ liftNumericArray2M f a1 a2 -- [Partial] Throws an impure exception when lengths of vectors do not match -- -- @since 0.5.6 -(!.!) :: (Numeric r e, Source r Ix1 e) => Vector r e -> Vector r e -> e +(!.!) :: (Numeric r e, Source r e) => Vector r e -> Vector r e -> e (!.!) v1 v2 = throwEither $ dotM v1 v2 {-# INLINE (!.!) #-} @@ -329,7 +328,7 @@ liftNumericArray2M f a1 a2 -- /__Throws Exception__/: `SizeMismatchException` when lengths of vectors do not match -- -- @since 0.5.6 -dotM :: (FoldNumeric r e, Source r Ix1 e, MonadThrow m) => Vector r e -> Vector r e -> m e +dotM :: (FoldNumeric r e, Source r e, MonadThrow m) => Vector r e -> Vector r e -> m e dotM v1 v2 | size v1 /= size v2 = throwM $ SizeMismatchException (size v1) (size v2) | comp == Seq = pure $! unsafeDotProduct v1 v2 @@ -340,7 +339,7 @@ dotM v1 v2 unsafeDotProductIO :: - (MonadUnliftIO m, FoldNumeric r b, Source r ix b) + (MonadUnliftIO m, Index ix, FoldNumeric r b, Source r b) => Array r ix b -> Array r ix b -> m b @@ -367,14 +366,14 @@ unsafeDotProductIO v1 v2 = do -- | Compute L2 norm of an array. -- -- @since 0.5.6 -normL2 :: (Floating e, FoldNumeric r e, Source r ix e) => Array r ix e -> e +normL2 :: (FoldNumeric r e, Source r e, Index ix, Floating e) => Array r ix e -> e normL2 v | getComp v == Seq = sqrt $! powerSumArray v 2 | otherwise = sqrt $! unsafePerformIO $ powerSumArrayIO v 2 {-# INLINE normL2 #-} powerSumArrayIO :: - (MonadUnliftIO m, FoldNumeric r b, Source r ix b) + (MonadUnliftIO m, Index ix, FoldNumeric r b, Source r b) => Array r ix b -> Int -> m b @@ -401,7 +400,7 @@ powerSumArrayIO v p = do -- -- @since 0.5.6 (.><) :: - (MonadThrow m, FoldNumeric r e, Source r Ix1 e, Source r Ix2 e) + (MonadThrow m, FoldNumeric r e, Source r e) => Matrix r e -- ^ Matrix -> Vector r e -- ^ Column vector (Used many times, so make sure it is computed) -> m (Vector D e) @@ -422,7 +421,7 @@ powerSumArrayIO v p = do -- -- @since 0.5.7 multiplyMatrixByVector :: - (MonadThrow m, Numeric r e, Mutable r Ix1 e, Mutable r Ix2 e) + (MonadThrow m, Numeric r e, Mutable r e) => Matrix r e -- ^ Matrix -> Vector r e -- ^ Column vector (Used many times, so make sure it is computed) -> m (Vector r e) @@ -436,7 +435,7 @@ multiplyMatrixByVector mm v = compute <$> mm .>< v -- -- @since 0.5.6 (!><) :: - (Numeric r e, Source r Ix1 e, Source r Ix2 e) + (Numeric r e, Source r e) => Matrix r e -- ^ Matrix -> Vector r e -- ^ Column vector (Used many times, so make sure it is computed) -> Vector D e @@ -450,7 +449,7 @@ multiplyMatrixByVector mm v = compute <$> mm .>< v -- /__Throws Exception__/: `SizeMismatchException` when inner dimensions of arrays do not match. -- -- @since 0.5.6 -(><.) :: (MonadThrow m, Numeric r e, Mutable r Ix1 e, Mutable r Ix2 e) => +(><.) :: (MonadThrow m, Numeric r e, Mutable r e) => Vector r e -- ^ Row vector -> Matrix r e -- ^ Matrix -> m (Vector r e) @@ -464,13 +463,13 @@ multiplyMatrixByVector mm v = compute <$> mm .>< v -- -- @since 0.5.7 multiplyVectorByMatrix :: - (MonadThrow m, Numeric r e, Mutable r Ix1 e, Mutable r Ix2 e) + (MonadThrow m, Numeric r e, Mutable r e) => Vector r e -- ^ Row vector -> Matrix r e -- ^ Matrix -> m (Vector r e) multiplyVectorByMatrix v mm | mRows /= n = throwM $ SizeMismatchException (Sz2 1 n) (size mm) - | mRows == 0 || mCols == 0 = pure $ setComp comp empty + | mRows == 0 || mCols == 0 = pure $ runST (unsafeFreeze comp =<< unsafeNew zeroSz) | otherwise = pure $! unsafePerformIO $ do @@ -501,7 +500,7 @@ multiplyVectorByMatrix v mm -- -- @since 0.5.6 (> Vector r e -- ^ Row vector (Used many times, so make sure it is computed) -> Matrix r e -- ^ Matrix -> Vector r e @@ -528,7 +527,7 @@ multiplyVectorByMatrix v mm -- ] -- -- @since 0.5.6 -(!> Matrix r e -> Matrix r e -> Matrix r e +(!> Matrix r e -> Matrix r e -> Matrix r e (!><.) :: (Numeric r e, Mutable r Ix2 e, MonadThrow m) => Matrix r e -> Matrix r e -> m (Matrix r e) +(.><.) :: (Numeric r e, Mutable r e, MonadThrow m) => Matrix r e -> Matrix r e -> m (Matrix r e) (.><.) = multiplyMatrices {-# INLINE (.><.) #-} @@ -547,12 +546,12 @@ multiplyVectorByMatrix v mm -- -- @since 0.5.6 multiplyMatrices :: - (Numeric r e, Mutable r Ix2 e, MonadThrow m) => Matrix r e -> Matrix r e -> m (Matrix r e) + (Numeric r e, Mutable r e, MonadThrow m) => Matrix r e -> Matrix r e -> m (Matrix r e) multiplyMatrices arrA arrB -- mA == 1 = -- TODO: call multiplyVectorByMatrix -- nA == 1 = -- TODO: call multiplyMatrixByVector | nA /= mB = throwM $ SizeMismatchException (size arrA) (size arrB) - | isEmpty arrA || isEmpty arrB = pure $ setComp comp empty + | isNull arrA || isNull arrB = pure $ runST (unsafeFreeze comp =<< unsafeNew zeroSz) | otherwise = pure $! unsafePerformIO $ do marrC <- newMArray (SafeSz (mA :. nB)) 0 withScheduler_ comp $ \scheduler -> do @@ -693,13 +692,13 @@ multiplyMatrices arrA arrB -- -- @since 0.5.6 multiplyMatricesTransposed :: - (Numeric r e, Manifest r Ix2 e, MonadThrow m) + (Numeric r e, Manifest r e, MonadThrow m) => Matrix r e -> Matrix r e -> m (Matrix D e) multiplyMatricesTransposed arr1 arr2 | n1 /= m2 = throwM $ SizeMismatchException (size arr1) (Sz2 m2 n2) - | isEmpty arr1 || isEmpty arr2 = pure $ setComp comp empty + | isNull arr1 || isNull arr2 = pure $ setComp comp empty | otherwise = pure $ DArray comp (SafeSz (m1 :. n2)) $ \(i :. j) -> @@ -711,7 +710,6 @@ multiplyMatricesTransposed arr1 arr2 SafeSz (n2 :. m2) = size arr2 {-# INLINE multiplyMatricesTransposed #-} - -- | Create an indentity matrix. -- -- ==== __Example__ @@ -812,7 +810,7 @@ signumA = unsafeLiftArray signum -- -- @since 0.4.0 (./.) :: - (Load r ix e, NumericFloat r e, MonadThrow m) + (Index ix, NumericFloat r e, MonadThrow m) => Array r ix e -> Array r ix e -> m (Array r ix e) @@ -834,7 +832,7 @@ signumA = unsafeLiftArray signum -- [ 0.2, 0.20792079, 0.21568628, 0.22330096, 0.23076923 ] -- -- @since 0.5.6 -(!/!) :: (Load r ix e, NumericFloat r e) => Array r ix e -> Array r ix e -> Array r ix e +(!/!) :: (Index ix, NumericFloat r e) => Array r ix e -> Array r ix e -> Array r ix e (!/!) a1 a2 = throwEither (a1 ./. a2) {-# INLINE (!/!) #-} @@ -927,7 +925,7 @@ logA = unsafeLiftArray log -- -- @since 0.4.0 logBaseA - :: (Source r1 ix e, Source r2 ix e, Floating e) + :: (Index ix, Source r1 e, Source r2 e, Floating e) => Array r1 ix e -> Array r2 ix e -> Array D ix e logBaseA = liftArray2Matching logBase {-# INLINE logBaseA #-} @@ -947,7 +945,7 @@ logBaseA = liftArray2Matching logBase -- -- @since 0.4.0 (.**) - :: (Source r1 ix e, Source r2 ix e, Floating e) + :: (Index ix, Source r1 e, Source r2 e, Floating e) => Array r1 ix e -> Array r2 ix e -> Array D ix e (.**) = liftArray2Matching (**) {-# INLINE (.**) #-} @@ -1076,7 +1074,7 @@ atanhA = unsafeLiftArray atanh -- -- @since 0.1.0 quotA - :: (Source r1 ix e, Source r2 ix e, Integral e) + :: (Index ix, Source r1 e, Source r2 e, Integral e) => Array r1 ix e -> Array r2 ix e -> Array D ix e quotA = liftArray2Matching quot {-# INLINE quotA #-} @@ -1090,7 +1088,7 @@ quotA = liftArray2Matching quot -- -- @since 0.1.0 remA - :: (Source r1 ix e, Source r2 ix e, Integral e) + :: (Index ix, Source r1 e, Source r2 e, Integral e) => Array r1 ix e -> Array r2 ix e -> Array D ix e remA = liftArray2Matching rem {-# INLINE remA #-} @@ -1104,7 +1102,7 @@ remA = liftArray2Matching rem -- -- @since 0.1.0 divA - :: (Source r1 ix e, Source r2 ix e, Integral e) + :: (Index ix, Source r1 e, Source r2 e, Integral e) => Array r1 ix e -> Array r2 ix e -> Array D ix e divA = liftArray2Matching div {-# INLINE divA #-} @@ -1121,7 +1119,7 @@ divA = liftArray2Matching div -- -- @since 0.1.0 modA - :: (Source r1 ix e, Source r2 ix e, Integral e) + :: (Index ix, Source r1 e, Source r2 e, Integral e) => Array r1 ix e -> Array r2 ix e -> Array D ix e modA = liftArray2Matching mod {-# INLINE modA #-} @@ -1137,7 +1135,7 @@ modA = liftArray2Matching mod -- -- @since 0.1.0 quotRemA - :: (Source r1 ix e, Source r2 ix e, Integral e) + :: (Index ix, Source r1 e, Source r2 e, Integral e) => Array r1 ix e -> Array r2 ix e -> (Array D ix e, Array D ix e) quotRemA arr1 = A.unzip . liftArray2Matching quotRem arr1 {-# INLINE quotRemA #-} @@ -1152,7 +1150,7 @@ quotRemA arr1 = A.unzip . liftArray2Matching quotRem arr1 -- -- @since 0.1.0 divModA - :: (Source r1 ix e, Source r2 ix e, Integral e) + :: (Index ix, Source r1 e, Source r2 e, Integral e) => Array r1 ix e -> Array r2 ix e -> (Array D ix e, Array D ix e) divModA arr1 = A.unzip . liftArray2Matching divMod arr1 {-# INLINE divModA #-} @@ -1164,9 +1162,7 @@ divModA arr1 = A.unzip . liftArray2Matching divMod arr1 -- > truncateA arr == map truncate arr -- -- @since 0.1.0 -truncateA - :: (Source r ix a, RealFrac a, Integral e) - => Array r ix a -> Array D ix e +truncateA :: (Index ix, Source r a, RealFrac a, Integral e) => Array r ix a -> Array D ix e truncateA = A.map truncate {-# INLINE truncateA #-} @@ -1176,7 +1172,7 @@ truncateA = A.map truncate -- > truncateA arr == map truncate arr -- -- @since 0.1.0 -roundA :: (Source r ix a, RealFrac a, Integral e) => Array r ix a -> Array D ix e +roundA :: (Index ix, Source r a, RealFrac a, Integral e) => Array r ix a -> Array D ix e roundA = A.map round {-# INLINE roundA #-} @@ -1186,7 +1182,7 @@ roundA = A.map round -- > truncateA arr == map truncate arr -- -- @since 0.1.0 -ceilingA :: (Source r ix a, RealFrac a, Integral e) => Array r ix a -> Array D ix e +ceilingA :: (Index ix, Source r a, RealFrac a, Integral e) => Array r ix a -> Array D ix e ceilingA = A.map ceiling {-# INLINE ceilingA #-} @@ -1196,7 +1192,7 @@ ceilingA = A.map ceiling -- > truncateA arr == map truncate arr -- -- @since 0.1.0 -floorA :: (Source r ix a, RealFrac a, Integral e) => Array r ix a -> Array D ix e +floorA :: (Index ix, Source r a, RealFrac a, Integral e) => Array r ix a -> Array D ix e floorA = A.map floor {-# INLINE floorA #-} @@ -1208,7 +1204,7 @@ floorA = A.map floor -- -- @since 0.1.0 atan2A :: - (Load r ix e, Numeric r e, RealFloat e, MonadThrow m) + (Index ix, Numeric r e, RealFloat e, MonadThrow m) => Array r ix e -> Array r ix e -> m (Array r ix e) diff --git a/massiv/src/Data/Massiv/Array/Numeric/Integral.hs b/massiv/src/Data/Massiv/Array/Numeric/Integral.hs index a1317d6b..882b1481 100644 --- a/massiv/src/Data/Massiv/Array/Numeric/Integral.hs +++ b/massiv/src/Data/Massiv/Array/Numeric/Integral.hs @@ -111,7 +111,7 @@ simpsonsStencil dx dim n -- | Integrate with a stencil along a particular dimension. integrateWith :: - (Fractional e, StrideLoad DW ix e, Mutable r ix e) + (Fractional e, StrideLoad DW ix e, Mutable r e) => (Dim -> Int -> Stencil ix e e) -> Dim -- ^ Dimension along which integration should be estimated. -> Int -- ^ @n@ - Number of samples @@ -126,7 +126,7 @@ integrateWith stencil dim n arr = -- | Compute an approximation of integral using a supplied rule in a form of `Stencil`. integralApprox :: - (Fractional e, StrideLoad DW ix e, Mutable r ix e) + (Fractional e, StrideLoad DW ix e, Mutable r e) => (e -> Dim -> Int -> Stencil ix e e) -- ^ Integration Stencil -> e -- ^ @d@ - Length of interval per cell -> Sz ix -- ^ @sz@ - Result size of the matrix @@ -144,7 +144,7 @@ integralApprox stencil d sz n arr = -- | Use midpoint rule to approximate an integral. midpointRule :: - (Fractional e, StrideLoad DW ix e, Mutable r ix e) + (Fractional e, StrideLoad DW ix e, Mutable r e) => Comp -- ^ Computation strategy. -> r -- ^ Intermediate array representation. -> ((Int -> e) -> ix -> e) -- ^ @f(x,y,...)@ - Function to integrate @@ -160,7 +160,7 @@ midpointRule comp r f a d sz n = -- | Use trapezoid rule to approximate an integral. trapezoidRule :: - (Fractional e, StrideLoad DW ix e, Mutable r ix e) + (Fractional e, StrideLoad DW ix e, Mutable r e) => Comp -- ^ Computation strategy -> r -- ^ Intermediate array representation -> ((Int -> e) -> ix -> e) -- ^ @f(x,y,...)@ - function to integrate @@ -175,7 +175,7 @@ trapezoidRule comp r f a d sz n = -- | Use Simpson's rule to approximate an integral. simpsonsRule :: - (Fractional e, StrideLoad DW ix e, Mutable r ix e) + (Fractional e, StrideLoad DW ix e, Mutable r e) => Comp -- ^ Computation strategy -> r -- ^ Intermediate array representation -> ((Int -> e) -> ix -> e) -- ^ @f(x,y,...)@ - Function to integrate diff --git a/massiv/src/Data/Massiv/Array/Ops/Construct.hs b/massiv/src/Data/Massiv/Array/Ops/Construct.hs index 53eb165e..7e607fd3 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Construct.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Construct.hs @@ -115,7 +115,7 @@ makeVectorR _ = makeArray newtype STA r ix a = STA {_runSTA :: forall s. MArray s r ix a -> ST s (Array r ix a)} -runSTA :: Mutable r ix e => Sz ix -> STA r ix e -> Array r ix e +runSTA :: (Mutable r e, Index ix) => Sz ix -> STA r ix e -> Array r ix e runSTA !sz (STA m) = runST (unsafeNew sz >>= m) {-# INLINE runSTA #-} @@ -127,7 +127,7 @@ runSTA !sz (STA m) = runST (unsafeNew sz >>= m) -- -- @since 0.2.6 makeArrayA :: - forall r ix e f. (Mutable r ix e, Applicative f) + forall r ix e f. (Mutable r e, Index ix, Applicative f) => Sz ix -> (ix -> f e) -> f (Array r ix e) @@ -147,7 +147,7 @@ makeArrayA !sz f = -- -- @since 0.4.5 makeArrayLinearA :: - forall r ix e f. (Mutable r ix e, Applicative f) + forall r ix e f. (Mutable r e, Index ix, Applicative f) => Sz ix -> (Int -> f e) -> f (Array r ix e) @@ -165,7 +165,7 @@ makeArrayLinearA !sz f = -- -- @since 0.2.6 makeArrayAR :: - forall r ix e f. (Mutable r ix e, Applicative f) + forall r ix e f. (Mutable r e, Index ix, Applicative f) => r -> Sz ix -> (ix -> f e) @@ -364,7 +364,7 @@ randomArray gen splitGen nextRandom comp sz = unsafeMakeLoadArray comp sz Nothin -- -- @since 0.3.4 randomArrayS :: - forall r ix e g. Mutable r ix e + forall r ix e g. (Mutable r e, Index ix) => g -- ^ Initial random value generator -> Sz ix -- ^ Resulting size of the array. -> (g -> (e, g)) @@ -404,7 +404,7 @@ randomArrayS gen sz nextRandom = -- -- @since 0.3.4 randomArrayWS :: - forall r ix e g m. (Mutable r ix e, MonadUnliftIO m, PrimMonad m) + forall r ix e g m. (Mutable r e, Index ix, MonadUnliftIO m, PrimMonad m) => WorkerStates g -- ^ Use `initWorkerStates` to initialize you per thread generators -> Sz ix -- ^ Resulting size of the array -> (g -> m e) -- ^ Generate the value using the per thread generator. @@ -662,7 +662,7 @@ enumFromStepN comp !from !step !sz = makeArrayLinear comp sz $ \ i -> from + fro -- -- @since 0.2.6 expandWithin :: - forall ix e r n a. (IsIndexDimension ix n, Manifest r (Lower ix) a) + forall ix e r n a. (IsIndexDimension ix n, Index (Lower ix), Manifest r a) => Dimension n -> Sz1 -> (a -> Ix1 -> e) @@ -682,7 +682,7 @@ expandWithin dim (Sz k) f arr = -- -- @since 0.2.6 expandWithin' - :: (Index ix, Manifest r (Lower ix) a) + :: (Index ix, Index (Lower ix), Manifest r a) => Dim -> Sz1 -> (a -> Ix1 -> b) @@ -696,7 +696,7 @@ expandWithin' dim k f arr = either throw id $ expandWithinM dim k f arr -- -- @since 0.4.0 expandWithinM - :: (Index ix, Manifest r (Lower ix) a, MonadThrow m) + :: (Index ix, Index (Lower ix), Manifest r a, MonadThrow m) => Dim -> Sz1 -> (a -> Ix1 -> b) @@ -714,7 +714,7 @@ expandWithinM dim k f arr = do -- -- @since 0.2.6 expandOuter - :: (Index ix, Manifest r (Lower ix) a) + :: (Index ix, Index (Lower ix), Manifest r a) => Sz1 -> (a -> Ix1 -> b) -> Array r (Lower ix) a @@ -732,7 +732,7 @@ expandOuter k f arr = -- -- @since 0.2.6 expandInner - :: (Index ix, Manifest r (Lower ix) a) + :: (Index ix, Index (Lower ix), Manifest r a) => Sz1 -> (a -> Ix1 -> b) -> Array r (Lower ix) a diff --git a/massiv/src/Data/Massiv/Array/Ops/Fold.hs b/massiv/src/Data/Massiv/Array/Ops/Fold.hs index 9ba51e64..8aaa682d 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Fold.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Fold.hs @@ -112,7 +112,7 @@ import Prelude hiding (all, and, any, foldl, foldr, map, maximum, minimum, or, p -- -- @since 0.2.4 ifoldMono :: - (Source r ix e, Monoid m) + (Index ix, Source r e, Monoid m) => (ix -> e -> m) -- ^ Convert each element of an array to an appropriate `Monoid`. -> Array r ix e -- ^ Source array -> m @@ -124,7 +124,7 @@ ifoldMono f = ifoldlInternal (\a ix e -> a `mappend` f ix e) mempty mappend memp -- -- @since 0.2.4 ifoldSemi :: - (Source r ix e, Semigroup m) + (Index ix, Source r e, Semigroup m) => (ix -> e -> m) -- ^ Convert each element of an array to an appropriate `Semigroup`. -> m -- ^ Initial element that must be neutral to the (`<>`) function. -> Array r ix e -- ^ Source array @@ -137,7 +137,7 @@ ifoldSemi f m = ifoldlInternal (\a ix e -> a <> f ix e) m (<>) m -- -- @since 0.1.6 foldSemi :: - (Source r ix e, Semigroup m) + (Index ix, Source r e, Semigroup m) => (e -> m) -- ^ Convert each element of an array to an appropriate `Semigroup`. -> m -- ^ Initial element that must be neutral to the (`<>`) function. -> Array r ix e -- ^ Source array @@ -149,7 +149,7 @@ foldSemi f m = foldlInternal (\a e -> a <> f e) m (<>) m -- | Left fold along a specified dimension with an index aware function. -- -- @since 0.2.4 -ifoldlWithin :: (Index (Lower ix), IsIndexDimension ix n, Source r ix e) => +ifoldlWithin :: (Index (Lower ix), IsIndexDimension ix n, Source r e) => Dimension n -> (ix -> a -> e -> a) -> a -> Array r ix e -> Array D (Lower ix) a ifoldlWithin dim = ifoldlWithin' (fromDimension dim) {-# INLINE ifoldlWithin #-} @@ -175,7 +175,7 @@ ifoldlWithin dim = ifoldlWithin' (fromDimension dim) -- [ [5,0], [6,1], [7,2], [8,3], [9,4] ] -- -- @since 0.2.4 -foldlWithin :: (Index (Lower ix), IsIndexDimension ix n, Source r ix e) => +foldlWithin :: (Index (Lower ix), IsIndexDimension ix n, Source r e) => Dimension n -> (a -> e -> a) -> a -> Array r ix e -> Array D (Lower ix) a foldlWithin dim f = ifoldlWithin dim (const f) {-# INLINE foldlWithin #-} @@ -184,7 +184,7 @@ foldlWithin dim f = ifoldlWithin dim (const f) -- | Right fold along a specified dimension with an index aware function. -- -- @since 0.2.4 -ifoldrWithin :: (Index (Lower ix), IsIndexDimension ix n, Source r ix e) => +ifoldrWithin :: (Index (Lower ix), IsIndexDimension ix n, Source r e) => Dimension n -> (ix -> e -> a -> a) -> a -> Array r ix e -> Array D (Lower ix) a ifoldrWithin dim = ifoldrWithin' (fromDimension dim) {-# INLINE ifoldrWithin #-} @@ -193,7 +193,7 @@ ifoldrWithin dim = ifoldrWithin' (fromDimension dim) -- | Right fold along a specified dimension. -- -- @since 0.2.4 -foldrWithin :: (Index (Lower ix), IsIndexDimension ix n, Source r ix e) => +foldrWithin :: (Index (Lower ix), IsIndexDimension ix n, Source r e) => Dimension n -> (e -> a -> a) -> a -> Array r ix e -> Array D (Lower ix) a foldrWithin dim f = ifoldrWithin dim (const f) {-# INLINE foldrWithin #-} @@ -203,7 +203,7 @@ foldrWithin dim f = ifoldrWithin dim (const f) -- will throw an exception on an invalid dimension. -- -- @since 0.2.4 -ifoldlWithin' :: (Index (Lower ix), Source r ix e) => +ifoldlWithin' :: (Index (Lower ix), Index ix, Source r e) => Dim -> (ix -> a -> e -> a) -> a -> Array r ix e -> Array D (Lower ix) a ifoldlWithin' dim f acc0 arr = makeArray (getComp arr) (SafeSz szl) $ \ixl -> @@ -224,7 +224,7 @@ ifoldlWithin' dim f acc0 arr = -- throw an exception on an invalid dimension. -- -- @since 0.2.4 -foldlWithin' :: (Index (Lower ix), Source r ix e) => +foldlWithin' :: (Index (Lower ix), Index ix, Source r e) => Dim -> (a -> e -> a) -> a -> Array r ix e -> Array D (Lower ix) a foldlWithin' dim f = ifoldlWithin' dim (const f) {-# INLINE foldlWithin' #-} @@ -235,7 +235,7 @@ foldlWithin' dim f = ifoldlWithin' dim (const f) -- -- -- @since 0.2.4 -ifoldrWithin' :: (Index (Lower ix), Source r ix e) => +ifoldrWithin' :: (Index (Lower ix), Index ix, Source r e) => Dim -> (ix -> e -> a -> a) -> a -> Array r ix e -> Array D (Lower ix) a ifoldrWithin' dim f acc0 arr = makeArray (getComp arr) (SafeSz szl) $ \ixl -> @@ -255,7 +255,7 @@ ifoldrWithin' dim f acc0 arr = -- will throw an exception on an invalid dimension. -- -- @since 0.2.4 -foldrWithin' :: (Index (Lower ix), Source r ix e) => +foldrWithin' :: (Index (Lower ix), Index ix, Source r e) => Dim -> (e -> a -> a) -> a -> Array r ix e -> Array D (Lower ix) a foldrWithin' dim f = ifoldrWithin' dim (const f) {-# INLINE foldrWithin' #-} @@ -264,7 +264,7 @@ foldrWithin' dim f = ifoldrWithin' dim (const f) -- | Left fold over the inner most dimension with index aware function. -- -- @since 0.2.4 -ifoldlInner :: (Index (Lower ix), Source r ix e) => +ifoldlInner :: (Index (Lower ix), Index ix, Source r e) => (ix -> a -> e -> a) -> a -> Array r ix e -> Array D (Lower ix) a ifoldlInner = ifoldlWithin' 1 {-# INLINE ifoldlInner #-} @@ -272,7 +272,7 @@ ifoldlInner = ifoldlWithin' 1 -- | Left fold over the inner most dimension. -- -- @since 0.2.4 -foldlInner :: (Index (Lower ix), Source r ix e) => +foldlInner :: (Index (Lower ix), Index ix, Source r e) => (a -> e -> a) -> a -> Array r ix e -> Array D (Lower ix) a foldlInner = foldlWithin' 1 {-# INLINE foldlInner #-} @@ -280,7 +280,7 @@ foldlInner = foldlWithin' 1 -- | Right fold over the inner most dimension with index aware function. -- -- @since 0.2.4 -ifoldrInner :: (Index (Lower ix), Source r ix e) => +ifoldrInner :: (Index (Lower ix), Index ix, Source r e) => (ix -> e -> a -> a) -> a -> Array r ix e -> Array D (Lower ix) a ifoldrInner = ifoldrWithin' 1 {-# INLINE ifoldrInner #-} @@ -288,7 +288,7 @@ ifoldrInner = ifoldrWithin' 1 -- | Right fold over the inner most dimension. -- -- @since 0.2.4 -foldrInner :: (Index (Lower ix), Source r ix e) => +foldrInner :: (Index (Lower ix), Index ix, Source r e) => (e -> a -> a) -> a -> Array r ix e -> Array D (Lower ix) a foldrInner = foldrWithin' 1 {-# INLINE foldrInner #-} @@ -296,7 +296,7 @@ foldrInner = foldrWithin' 1 -- | Monoidal fold over the inner most dimension. -- -- @since 0.4.3 -foldInner :: (Monoid e, Index (Lower ix), Source r ix e) => Array r ix e -> Array D (Lower ix) e +foldInner :: (Monoid e, Index (Lower ix), Index ix, Source r e) => Array r ix e -> Array D (Lower ix) e foldInner = foldlInner mappend mempty {-# INLINE foldInner #-} @@ -304,7 +304,7 @@ foldInner = foldlInner mappend mempty -- -- @since 0.4.3 foldWithin :: - (Source r ix a, Monoid a, Index (Lower ix), IsIndexDimension ix n) + (Source r a, Monoid a, Index (Lower ix), IsIndexDimension ix n) => Dimension n -> Array r ix a -> Array D (Lower ix) a @@ -316,7 +316,7 @@ foldWithin dim = foldlWithin dim mappend mempty -- -- @since 0.4.3 foldWithin' :: - (Source r ix a, Monoid a, Index (Lower ix)) + (Index ix, Source r a, Monoid a, Index (Lower ix)) => Dim -> Array r ix a -> Array D (Lower ix) a @@ -397,7 +397,7 @@ ifoldInnerSlice f arr = foldMono g $ range (getComp arr) 0 (unSz k) -- | /O(n)/ - Compute maximum of all elements. -- -- @since 0.3.0 -maximumM :: (MonadThrow m, Source r ix e, Ord e) => Array r ix e -> m e +maximumM :: (MonadThrow m, Load r ix e, Source r e, Ord e) => Array r ix e -> m e maximumM arr = if isEmpty arr then throwM (SizeEmptyException (size arr)) @@ -409,7 +409,7 @@ maximumM arr = -- | /O(n)/ - Compute maximum of all elements. -- -- @since 0.3.0 -maximum' :: (Source r ix e, Ord e) => Array r ix e -> e +maximum' :: (Load r ix e, Source r e, Ord e) => Array r ix e -> e maximum' = either throw id . maximumM {-# INLINE maximum' #-} @@ -417,7 +417,7 @@ maximum' = either throw id . maximumM -- | /O(n)/ - Compute minimum of all elements. -- -- @since 0.3.0 -minimumM :: (MonadThrow m, Source r ix e, Ord e) => Array r ix e -> m e +minimumM :: (MonadThrow m, Load r ix e, Source r e, Ord e) => Array r ix e -> m e minimumM arr = if isEmpty arr then throwM (SizeEmptyException (size arr)) @@ -428,7 +428,7 @@ minimumM arr = -- | /O(n)/ - Compute minimum of all elements. -- -- @since 0.3.0 -minimum' :: (Source r ix e, Ord e) => Array r ix e -> e +minimum' :: (Load r ix e, Source r e, Ord e) => Array r ix e -> e minimum' = either throw id . minimumM {-# INLINE minimum' #-} @@ -437,7 +437,7 @@ minimum' = either throw id . minimumM -- -- -- -- @since 0.1.0 -- sum' :: --- forall r ix e. (Source r ix e, Numeric r e) +-- forall r ix e. (Index ix, Source r e, Numeric r e) -- => Array r ix e -- -> IO e -- sum' = splitReduce (\_ -> pure . sumArray) (\x y -> pure (x + y)) 0 @@ -446,7 +446,7 @@ minimum' = either throw id . minimumM -- | /O(n)/ - Compute sum of all elements. -- -- @since 0.1.0 -sum :: (Source r ix e, Num e) => Array r ix e -> e +sum :: (Index ix, Source r e, Num e) => Array r ix e -> e sum = foldlInternal (+) 0 (+) 0 {-# INLINE sum #-} @@ -454,7 +454,7 @@ sum = foldlInternal (+) 0 (+) 0 -- | /O(n)/ - Compute product of all elements. -- -- @since 0.1.0 -product :: (Source r ix e, Num e) => Array r ix e -> e +product :: (Index ix, Source r e, Num e) => Array r ix e -> e product = foldlInternal (*) 1 (*) 1 {-# INLINE product #-} @@ -462,7 +462,7 @@ product = foldlInternal (*) 1 (*) 1 -- | /O(n)/ - Compute conjunction of all elements. -- -- @since 0.1.0 -and :: Source r ix Bool => Array r ix Bool -> Bool +and :: (Index ix, Source r Bool) => Array r ix Bool -> Bool and = all id {-# INLINE and #-} @@ -470,7 +470,7 @@ and = all id -- | /O(n)/ - Compute disjunction of all elements. -- -- @since 0.1.0 -or :: Source r ix Bool => Array r ix Bool -> Bool +or :: (Index ix, Source r Bool) => Array r ix Bool -> Bool or = any id {-# INLINE or #-} @@ -478,14 +478,14 @@ or = any id -- | /O(n)/ - Determines whether all elements of the array satisfy a predicate. -- -- @since 0.1.0 -all :: Source r ix e => (e -> Bool) -> Array r ix e -> Bool +all :: (Index ix, Source r e) => (e -> Bool) -> Array r ix e -> Bool all f = not . any (not . f) {-# INLINE all #-} -- | /O(n)/ - Determines whether an element is present in the array. -- -- @since 0.5.5 -elem :: (Eq e, Source r ix e) => e -> Array r ix e -> Bool +elem :: (Eq e, Index ix, Source r e) => e -> Array r ix e -> Bool elem e = any (e ==) {-# INLINE elem #-} diff --git a/massiv/src/Data/Massiv/Array/Ops/Fold/Internal.hs b/massiv/src/Data/Massiv/Array/Ops/Fold/Internal.hs index f55b2567..6388eef3 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Fold/Internal.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Fold/Internal.hs @@ -41,7 +41,7 @@ module Data.Massiv.Array.Ops.Fold.Internal , ifoldrP , ifoldlIO , ifoldrIO - -- , splitReduce + , splitReduce , any , anySu , anyPu @@ -60,7 +60,7 @@ import System.IO.Unsafe (unsafePerformIO) -- -- @since 0.3.0 fold :: - (Monoid e, Source r ix e) + (Monoid e, Index ix, Source r e) => Array r ix e -- ^ Source array -> e fold = foldlInternal mappend mempty mappend mempty @@ -73,7 +73,7 @@ fold = foldlInternal mappend mempty mappend mempty -- -- @since 0.1.4 foldMono :: - (Source r ix e, Monoid m) + (Index ix, Source r e, Monoid m) => (e -> m) -- ^ Convert each element of an array to an appropriate `Monoid`. -> Array r ix e -- ^ Source array -> m @@ -84,7 +84,7 @@ foldMono f = foldlInternal (\a e -> a `mappend` f e) mempty mappend mempty -- | /O(n)/ - Monadic left fold. -- -- @since 0.1.0 -foldlM :: (Source r ix e, Monad m) => (a -> e -> m a) -> a -> Array r ix e -> m a +foldlM :: (Index ix, Source r e, Monad m) => (a -> e -> m a) -> a -> Array r ix e -> m a foldlM f = ifoldlM (\ a _ b -> f a b) {-# INLINE foldlM #-} @@ -92,7 +92,7 @@ foldlM f = ifoldlM (\ a _ b -> f a b) -- | /O(n)/ - Monadic left fold, that discards the result. -- -- @since 0.1.0 -foldlM_ :: (Source r ix e, Monad m) => (a -> e -> m a) -> a -> Array r ix e -> m () +foldlM_ :: (Index ix, Source r e, Monad m) => (a -> e -> m a) -> a -> Array r ix e -> m () foldlM_ f = ifoldlM_ (\ a _ b -> f a b) {-# INLINE foldlM_ #-} @@ -100,7 +100,7 @@ foldlM_ f = ifoldlM_ (\ a _ b -> f a b) -- | /O(n)/ - Monadic left fold with an index aware function. -- -- @since 0.1.0 -ifoldlM :: (Source r ix e, Monad m) => (a -> ix -> e -> m a) -> a -> Array r ix e -> m a +ifoldlM :: (Index ix, Source r e, Monad m) => (a -> ix -> e -> m a) -> a -> Array r ix e -> m a ifoldlM f !acc !arr = iterM zeroIndex (unSz (size arr)) (pureIndex 1) (<) acc $ \ !ix !a -> f a ix (unsafeIndex arr ix) {-# INLINE ifoldlM #-} @@ -109,7 +109,7 @@ ifoldlM f !acc !arr = -- | /O(n)/ - Monadic left fold with an index aware function, that discards the result. -- -- @since 0.1.0 -ifoldlM_ :: (Source r ix e, Monad m) => (a -> ix -> e -> m a) -> a -> Array r ix e -> m () +ifoldlM_ :: (Index ix, Source r e, Monad m) => (a -> ix -> e -> m a) -> a -> Array r ix e -> m () ifoldlM_ f acc = void . ifoldlM f acc {-# INLINE ifoldlM_ #-} @@ -117,7 +117,7 @@ ifoldlM_ f acc = void . ifoldlM f acc -- | /O(n)/ - Monadic right fold. -- -- @since 0.1.0 -foldrM :: (Source r ix e, Monad m) => (e -> a -> m a) -> a -> Array r ix e -> m a +foldrM :: (Index ix, Source r e, Monad m) => (e -> a -> m a) -> a -> Array r ix e -> m a foldrM f = ifoldrM (\_ e a -> f e a) {-# INLINE foldrM #-} @@ -125,7 +125,7 @@ foldrM f = ifoldrM (\_ e a -> f e a) -- | /O(n)/ - Monadic right fold, that discards the result. -- -- @since 0.1.0 -foldrM_ :: (Source r ix e, Monad m) => (e -> a -> m a) -> a -> Array r ix e -> m () +foldrM_ :: (Index ix, Source r e, Monad m) => (e -> a -> m a) -> a -> Array r ix e -> m () foldrM_ f = ifoldrM_ (\_ e a -> f e a) {-# INLINE foldrM_ #-} @@ -133,7 +133,7 @@ foldrM_ f = ifoldrM_ (\_ e a -> f e a) -- | /O(n)/ - Monadic right fold with an index aware function. -- -- @since 0.1.0 -ifoldrM :: (Source r ix e, Monad m) => (ix -> e -> a -> m a) -> a -> Array r ix e -> m a +ifoldrM :: (Index ix, Source r e, Monad m) => (ix -> e -> a -> m a) -> a -> Array r ix e -> m a ifoldrM f !acc !arr = iterM (liftIndex (subtract 1) (unSz (size arr))) zeroIndex (pureIndex (-1)) (>=) acc $ \ !ix !acc0 -> f ix (unsafeIndex arr ix) acc0 @@ -143,7 +143,7 @@ ifoldrM f !acc !arr = -- | /O(n)/ - Monadic right fold with an index aware function, that discards the result. -- -- @since 0.1.0 -ifoldrM_ :: (Source r ix e, Monad m) => (ix -> e -> a -> m a) -> a -> Array r ix e -> m () +ifoldrM_ :: (Index ix, Source r e, Monad m) => (ix -> e -> a -> m a) -> a -> Array r ix e -> m () ifoldrM_ f !acc !arr = void $ ifoldrM f acc arr {-# INLINE ifoldrM_ #-} @@ -152,7 +152,7 @@ ifoldrM_ f !acc !arr = void $ ifoldrM f acc arr -- | /O(n)/ - Left fold, computed sequentially with lazy accumulator. -- -- @since 0.1.0 -lazyFoldlS :: Source r ix e => (a -> e -> a) -> a -> Array r ix e -> a +lazyFoldlS :: (Index ix, Source r e) => (a -> e -> a) -> a -> Array r ix e -> a lazyFoldlS f initAcc arr = go initAcc 0 where len = totalElem (size arr) @@ -165,7 +165,7 @@ lazyFoldlS f initAcc arr = go initAcc 0 -- | /O(n)/ - Right fold, computed sequentially with lazy accumulator. -- -- @since 0.1.0 -lazyFoldrS :: Source r ix e => (e -> a -> a) -> a -> Array r ix e -> a +lazyFoldrS :: (Index ix, Source r e) => (e -> a -> a) -> a -> Array r ix e -> a lazyFoldrS = foldrFB {-# INLINE lazyFoldrS #-} @@ -173,7 +173,7 @@ lazyFoldrS = foldrFB -- | /O(n)/ - Left fold, computed sequentially. -- -- @since 0.1.0 -foldlS :: Source r ix e => (a -> e -> a) -> a -> Array r ix e -> a +foldlS :: (Index ix, Source r e) => (a -> e -> a) -> a -> Array r ix e -> a foldlS f = ifoldlS (\ a _ e -> f a e) {-# INLINE foldlS #-} @@ -181,7 +181,7 @@ foldlS f = ifoldlS (\ a _ e -> f a e) -- | /O(n)/ - Left fold with an index aware function, computed sequentially. -- -- @since 0.1.0 -ifoldlS :: Source r ix e +ifoldlS :: (Index ix, Source r e) => (a -> ix -> e -> a) -> a -> Array r ix e -> a ifoldlS f acc = runIdentity . ifoldlM (\ a ix e -> return $ f a ix e) acc {-# INLINE ifoldlS #-} @@ -190,7 +190,7 @@ ifoldlS f acc = runIdentity . ifoldlM (\ a ix e -> return $ f a ix e) acc -- | /O(n)/ - Right fold, computed sequentially. -- -- @since 0.1.0 -foldrS :: Source r ix e => (e -> a -> a) -> a -> Array r ix e -> a +foldrS :: (Index ix, Source r e) => (e -> a -> a) -> a -> Array r ix e -> a foldrS f = ifoldrS (\_ e a -> f e a) {-# INLINE foldrS #-} @@ -198,7 +198,7 @@ foldrS f = ifoldrS (\_ e a -> f e a) -- | /O(n)/ - Right fold with an index aware function, computed sequentially. -- -- @since 0.1.0 -ifoldrS :: Source r ix e => (ix -> e -> a -> a) -> a -> Array r ix e -> a +ifoldrS :: (Index ix, Source r e) => (ix -> e -> a -> a) -> a -> Array r ix e -> a ifoldrS f acc = runIdentity . ifoldrM (\ ix e a -> return $ f ix e a) acc {-# INLINE ifoldrS #-} @@ -206,7 +206,7 @@ ifoldrS f acc = runIdentity . ifoldrM (\ ix e a -> return $ f ix e a) acc -- | Version of foldr that supports @foldr/build@ list fusion implemented by GHC. -- -- @since 0.1.0 -foldrFB :: Source r ix e => (e -> b -> b) -> b -> Array r ix e -> b +foldrFB :: (Index ix, Source r e) => (e -> b -> b) -> b -> Array r ix e -> b foldrFB c n arr = go 0 where !k = totalElem (size arr) @@ -235,7 +235,7 @@ foldrFB c n arr = go 0 -- [1,0,3,2,5,4] -- -- @since 0.1.0 -foldlP :: (MonadIO m, Source r ix e) => +foldlP :: (MonadIO m, Index ix, Source r e) => (a -> e -> a) -- ^ Folding function @g@. -> a -- ^ Accumulator. Will be applied to @g@ multiple times, thus must be neutral. -> (b -> a -> b) -- ^ Chunk results folding function @f@. @@ -249,7 +249,7 @@ foldlP f fAcc g gAcc = liftIO . ifoldlP (\ x _ -> f x) fAcc g gAcc -- element it is being applied to. -- -- @since 0.1.0 -ifoldlP :: (MonadIO m, Source r ix e) => +ifoldlP :: (MonadIO m, Index ix, Source r e) => (a -> ix -> e -> a) -> a -> (b -> a -> b) -> b -> Array r ix e -> m b ifoldlP f fAcc g gAcc = liftIO . ifoldlIO (\acc ix -> return . f acc ix) fAcc (\acc -> return . g acc) gAcc @@ -270,7 +270,7 @@ ifoldlP f fAcc g gAcc = -- [[0,1],[2,3],[4,5]] -- -- @since 0.1.0 -foldrP :: (MonadIO m, Source r ix e) => +foldrP :: (MonadIO m, Index ix, Source r e) => (e -> a -> a) -> a -> (a -> b -> b) -> b -> Array r ix e -> m b foldrP f fAcc g gAcc = liftIO . ifoldrP (const f) fAcc g gAcc {-# INLINE foldrP #-} @@ -282,7 +282,7 @@ foldrP f fAcc g gAcc = liftIO . ifoldrP (const f) fAcc g gAcc -- -- @since 0.1.0 ifoldrP :: - (MonadIO m, Source r ix e) + (MonadIO m, Index ix, Source r e) => (ix -> e -> a -> a) -> a -> (a -> b -> b) @@ -295,12 +295,12 @@ ifoldrP f fAcc g gAcc = liftIO . ifoldrIO (\ix e -> pure . f ix e) fAcc (\e -> p -- | This folding function breaks referential transparency on some functions -- @f@, therefore it is kept here for internal use only. -foldlInternal :: Source r ix e => (a -> e -> a) -> a -> (b -> a -> b) -> b -> Array r ix e -> b +foldlInternal :: (Index ix, Source r e) => (a -> e -> a) -> a -> (b -> a -> b) -> b -> Array r ix e -> b foldlInternal g initAcc f resAcc = unsafePerformIO . foldlP g initAcc f resAcc {-# INLINE foldlInternal #-} -ifoldlInternal :: Source r ix e => (a -> ix -> e -> a) -> a -> (b -> a -> b) -> b -> Array r ix e -> b +ifoldlInternal :: (Index ix, Source r e) => (a -> ix -> e -> a) -> a -> (b -> a -> b) -> b -> Array r ix e -> b ifoldlInternal g initAcc f resAcc = unsafePerformIO . ifoldlP g initAcc f resAcc {-# INLINE ifoldlInternal #-} @@ -309,7 +309,7 @@ ifoldlInternal g initAcc f resAcc = unsafePerformIO . ifoldlP g initAcc f resAcc -- -- @since 0.1.0 ifoldlIO :: - (MonadUnliftIO m, Source r ix e) + (MonadUnliftIO m, Index ix, Source r e) => (a -> ix -> e -> m a) -- ^ Index aware folding IO action -> a -- ^ Accumulator -> (b -> a -> m b) -- ^ Folding action that is applied to the results of a parallel fold @@ -335,40 +335,39 @@ ifoldlIO f !initAcc g !tAcc !arr F.foldlM g tAcc results {-# INLINE ifoldlIO #-} --- -- | Split an array into linear row-major vector chunks and apply an action to each of --- -- them. Number of chunks will depend on the computation strategy. Results of each action --- -- will be combined with a folding function. --- -- --- -- @since 0.6.0 --- splitReduce :: --- (MonadUnliftIO m, Source r ix e) --- => (Scheduler m a -> BatchId -> Array r Ix1 e -> m a) --- -> (b -> a -> m b) -- ^ Folding action that is applied to the results of a parallel fold --- -> b -- ^ Accumulator for chunks folding --- -> Array r ix e --- -> m b --- splitReduce f g !tAcc !arr = do --- let !sz = size arr --- !totalLength = totalElem sz --- results <- --- withScheduler (getComp arr) $ \scheduler -> do --- batchId <- getCurrentBatchId scheduler --- splitLinearly (numWorkers scheduler) totalLength $ \chunkLength slackStart -> do --- loopM_ 0 (< slackStart) (+ chunkLength) $ \ !start -> --- scheduleWork scheduler $ f scheduler batchId $ --- unsafeLinearSlice start (SafeSz chunkLength) arr --- when (slackStart < totalLength) $ --- scheduleWork scheduler $ f scheduler batchId $ --- unsafeLinearSlice slackStart (SafeSz (totalLength - slackStart)) arr --- F.foldlM g tAcc results --- {-# INLINE splitReduce #-} +-- | Split an array into linear row-major vector chunks and apply an action to each of +-- them. Number of chunks will depend on the computation strategy. Results of each action +-- will be combined with a folding function. +-- +-- @since 0.6.0 +splitReduce :: + (MonadUnliftIO m, Index ix, Source r e) + => (Scheduler m a -> Vector r e -> m a) + -> (b -> a -> m b) -- ^ Folding action that is applied to the results of a parallel fold + -> b -- ^ Accumulator for chunks folding + -> Array r ix e + -> m b +splitReduce f g !tAcc !arr = do + let !sz = size arr + !totalLength = totalElem sz + results <- + withScheduler (getComp arr) $ \scheduler -> do + splitLinearly (numWorkers scheduler) totalLength $ \chunkLength slackStart -> do + loopM_ 0 (< slackStart) (+ chunkLength) $ \ !start -> + scheduleWork scheduler $ f scheduler $ + unsafeLinearSlice start (SafeSz chunkLength) arr + when (slackStart < totalLength) $ + scheduleWork scheduler $ f scheduler $ + unsafeLinearSlice slackStart (SafeSz (totalLength - slackStart)) arr + F.foldlM g tAcc results +{-# INLINE splitReduce #-} -- | Similar to `ifoldrP`, except that folding functions themselves do live in IO -- -- @since 0.1.0 -ifoldrIO :: (MonadUnliftIO m, Source r ix e) => +ifoldrIO :: (MonadUnliftIO m, Index ix, Source r e) => (ix -> e -> a -> m a) -> a -> (a -> b -> m b) -> b -> Array r ix e -> m b ifoldrIO f !initAcc g !tAcc !arr | getComp arr == Seq = ifoldrM f initAcc arr >>= (`g` tAcc) @@ -390,7 +389,7 @@ ifoldrIO f !initAcc g !tAcc !arr {-# INLINE ifoldrIO #-} -- | Sequential implementation of `any` with unrolling -anySu :: Source r ix a => (a -> Bool) -> Array r ix a -> Bool +anySu :: (Index ix, Source r e) => (e -> Bool) -> Array r ix e -> Bool anySu f arr = go 0 where !k = elemsCount arr @@ -409,12 +408,12 @@ anySu f arr = go 0 -- | Implementaton of `any` on a slice of an array with short-circuiting using batch cancellation. anySliceSuM :: - Source r ix a + (Index ix, Source r e) => Batch IO Bool -> Ix1 -> Sz1 - -> (a -> Bool) - -> Array r ix a + -> (e -> Bool) + -> Array r ix e -> IO Bool anySliceSuM batch ix0 (Sz k) f arr = go ix0 where @@ -444,7 +443,7 @@ anySliceSuM batch ix0 (Sz k) f arr = go ix0 -- | Parallelizable implementation of `any` with unrolling -anyPu :: Source r ix e => (e -> Bool) -> Array r ix e -> IO Bool +anyPu :: (Index ix, Source r e) => (e -> Bool) -> Array r ix e -> IO Bool anyPu f arr = do let !sz = size arr !totalLength = totalElem sz @@ -464,7 +463,7 @@ anyPu f arr = do -- | /O(n)/ - Determines whether any element of the array satisfies a predicate. -- -- @since 0.1.0 -any :: Source r ix e => (e -> Bool) -> Array r ix e -> Bool +any :: (Index ix, Source r e) => (e -> Bool) -> Array r ix e -> Bool any f arr = case getComp arr of Seq -> anySu f arr diff --git a/massiv/src/Data/Massiv/Array/Ops/Map.hs b/massiv/src/Data/Massiv/Array/Ops/Map.hs index 2a091e17..9c657491 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Map.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Map.hs @@ -85,7 +85,9 @@ import Prelude hiding (map, mapM, mapM_, sequenceA, traverse, unzip, unzip3, -------------------------------------------------------------------------------- -- | Map a function over an array -map :: Source r ix e' => (e' -> e) -> Array r ix e' -> Array D ix e +-- +-- @since 0.1.0 +map :: (Index ix, Source r e') => (e' -> e) -> Array r ix e' -> Array D ix e map f = imap (const f) {-# INLINE map #-} @@ -95,13 +97,17 @@ map f = imap (const f) -------------------------------------------------------------------------------- -- | Zip two arrays -zip :: (Source r1 ix e1, Source r2 ix e2) +-- +-- @since 0.1.0 +zip :: (Index ix, Source r1 e1, Source r2 e2) => Array r1 ix e1 -> Array r2 ix e2 -> Array D ix (e1, e2) zip = zipWith (,) {-# INLINE zip #-} -- | Zip three arrays -zip3 :: (Source r1 ix e1, Source r2 ix e2, Source r3 ix e3) +-- +-- @since 0.1.0 +zip3 :: (Index ix, Source r1 e1, Source r2 e2, Source r3 e3) => Array r1 ix e1 -> Array r2 ix e2 -> Array r3 ix e3 -> Array D ix (e1, e2, e3) zip3 = zipWith3 (,,) {-# INLINE zip3 #-} @@ -110,7 +116,7 @@ zip3 = zipWith3 (,,) -- -- @since 0.5.4 zip4 :: - (Source r1 ix e1, Source r2 ix e2, Source r3 ix e3, Source r4 ix e4) + (Index ix, Source r1 e1, Source r2 e2, Source r3 e3, Source r4 e4) => Array r1 ix e1 -> Array r2 ix e2 -> Array r3 ix e3 @@ -120,12 +126,16 @@ zip4 = zipWith4 (,,,) {-# INLINE zip4 #-} -- | Unzip two arrays -unzip :: Source r ix (e1, e2) => Array r ix (e1, e2) -> (Array D ix e1, Array D ix e2) +-- +-- @since 0.1.0 +unzip :: (Index ix, Source r (e1, e2)) => Array r ix (e1, e2) -> (Array D ix e1, Array D ix e2) unzip arr = (map fst arr, map snd arr) {-# INLINE unzip #-} -- | Unzip three arrays -unzip3 :: Source r ix (e1, e2, e3) +-- +-- @since 0.1.0 +unzip3 :: (Index ix, Source r (e1, e2, e3)) => Array r ix (e1, e2, e3) -> (Array D ix e1, Array D ix e2, Array D ix e3) unzip3 arr = (map (\ (e, _, _) -> e) arr, map (\ (_, e, _) -> e) arr, map (\ (_, _, e) -> e) arr) {-# INLINE unzip3 #-} @@ -133,7 +143,7 @@ unzip3 arr = (map (\ (e, _, _) -> e) arr, map (\ (_, e, _) -> e) arr, map (\ (_, -- | Unzip four arrays -- -- @since 0.5.4 -unzip4 :: Source r ix (e1, e2, e3, e4) +unzip4 :: (Index ix, Source r (e1, e2, e3, e4)) => Array r ix (e1, e2, e3, e4) -> (Array D ix e1, Array D ix e2, Array D ix e3, Array D ix e4) unzip4 arr = ( map (\(e, _, _, _) -> e) arr @@ -148,14 +158,14 @@ unzip4 arr = -- | Zip two arrays with a function. Resulting array will be an intersection of -- source arrays in case their dimensions do not match. -zipWith :: (Source r1 ix e1, Source r2 ix e2) +zipWith :: (Index ix, Source r1 e1, Source r2 e2) => (e1 -> e2 -> e) -> Array r1 ix e1 -> Array r2 ix e2 -> Array D ix e zipWith f = izipWith (\ _ e1 e2 -> f e1 e2) {-# INLINE zipWith #-} -- | Just like `zipWith`, except with an index aware function. -izipWith :: (Source r1 ix e1, Source r2 ix e2) +izipWith :: (Index ix, Source r1 e1, Source r2 e2) => (ix -> e1 -> e2 -> e) -> Array r1 ix e1 -> Array r2 ix e2 -> Array D ix e izipWith f arr1 arr2 = DArray @@ -166,7 +176,7 @@ izipWith f arr1 arr2 = -- | Just like `zipWith`, except zip three arrays with a function. -zipWith3 :: (Source r1 ix e1, Source r2 ix e2, Source r3 ix e3) +zipWith3 :: (Index ix, Source r1 e1, Source r2 e2, Source r3 e3) => (e1 -> e2 -> e3 -> e) -> Array r1 ix e1 -> Array r2 ix e2 -> Array r3 ix e3 -> Array D ix e zipWith3 f = izipWith3 (\ _ e1 e2 e3 -> f e1 e2 e3) {-# INLINE zipWith3 #-} @@ -174,7 +184,7 @@ zipWith3 f = izipWith3 (\ _ e1 e2 e3 -> f e1 e2 e3) -- | Just like `zipWith3`, except with an index aware function. izipWith3 - :: (Source r1 ix e1, Source r2 ix e2, Source r3 ix e3) + :: (Index ix, Source r1 e1, Source r2 e2, Source r3 e3) => (ix -> e1 -> e2 -> e3 -> e) -> Array r1 ix e1 -> Array r2 ix e2 @@ -197,7 +207,7 @@ izipWith3 f arr1 arr2 arr3 = -- -- @since 0.5.4 zipWith4 :: - (Source r1 ix e1, Source r2 ix e2, Source r3 ix e3, Source r4 ix e4) + (Index ix, Source r1 e1, Source r2 e2, Source r3 e3, Source r4 e4) => (e1 -> e2 -> e3 -> e4 -> e) -> Array r1 ix e1 -> Array r2 ix e2 @@ -212,7 +222,7 @@ zipWith4 f = izipWith4 (\ _ e1 e2 e3 e4 -> f e1 e2 e3 e4) -- -- @since 0.5.4 izipWith4 - :: (Source r1 ix e1, Source r2 ix e2, Source r3 ix e3, Source r4 ix e4) + :: (Index ix, Source r1 e1, Source r2 e2, Source r3 e3, Source r4 e4) => (ix -> e1 -> e2 -> e3 -> e4 -> e) -> Array r1 ix e1 -> Array r2 ix e2 @@ -239,7 +249,7 @@ izipWith4 f arr1 arr2 arr3 arr4 = -- -- @since 0.3.0 zipWithA :: - (Source r1 ix e1, Source r2 ix e2, Applicative f, Mutable r ix e) + (Source r1 e1, Source r2 e2, Applicative f, Mutable r e, Index ix) => (e1 -> e2 -> f e) -> Array r1 ix e1 -> Array r2 ix e2 @@ -252,7 +262,7 @@ zipWithA f = izipWithA (const f) -- -- @since 0.3.0 izipWithA :: - (Source r1 ix e1, Source r2 ix e2, Applicative f, Mutable r ix e) + (Source r1 e1, Source r2 e2, Applicative f, Mutable r e, Index ix) => (ix -> e1 -> e2 -> f e) -> Array r1 ix e1 -> Array r2 ix e2 @@ -268,7 +278,7 @@ izipWithA f arr1 arr2 = -- -- @since 0.3.0 zipWith3A :: - (Source r1 ix e1, Source r2 ix e2, Source r3 ix e3, Applicative f, Mutable r ix e) + (Source r1 e1, Source r2 e2, Source r3 e3, Applicative f, Mutable r e, Index ix) => (e1 -> e2 -> e3 -> f e) -> Array r1 ix e1 -> Array r2 ix e2 @@ -281,7 +291,7 @@ zipWith3A f = izipWith3A (const f) -- -- @since 0.3.0 izipWith3A :: - (Source r1 ix e1, Source r2 ix e2, Source r3 ix e3, Applicative f, Mutable r ix e) + (Source r1 e1, Source r2 e2, Source r3 e3, Applicative f, Mutable r e, Index ix) => (ix -> e1 -> e2 -> e3 -> f e) -> Array r1 ix e1 -> Array r2 ix e2 @@ -304,7 +314,7 @@ izipWith3A f arr1 arr2 arr3 = -- -- @since 0.1.4 liftArray2 - :: (Source r1 ix a, Source r2 ix b) + :: (Index ix, Source r1 a, Source r2 b) => (a -> b -> e) -> Array r1 ix a -> Array r2 ix b -> Array D ix e liftArray2 f !arr1 !arr2 | sz1 == oneSz = map (f (unsafeIndex arr1 zeroIndex)) arr2 @@ -329,7 +339,7 @@ liftArray2 f !arr1 !arr2 -- @since 0.2.6 -- traverseA :: - forall r ix e r' a f . (Source r' ix a, Mutable r ix e, Applicative f) + forall r ix e r' a f . (Source r' a, Mutable r e, Index ix, Applicative f) => (a -> f e) -> Array r' ix a -> f (Array r ix e) @@ -340,7 +350,11 @@ traverseA f arr = makeArrayLinearA (size arr) (f . unsafeLinearIndex arr) -- -- @since 0.3.0 -- -traverseA_ :: forall r ix e a f . (Source r ix e, Applicative f) => (e -> f a) -> Array r ix e -> f () +traverseA_ :: + forall r ix e a f. (Index ix, Source r e, Applicative f) + => (e -> f a) + -> Array r ix e + -> f () traverseA_ f arr = loopA_ 0 (< totalElem (size arr)) (+ 1) (f . unsafeLinearIndex arr) {-# INLINE traverseA_ #-} @@ -349,7 +363,7 @@ traverseA_ f arr = loopA_ 0 (< totalElem (size arr)) (+ 1) (f . unsafeLinearInde -- @since 0.3.0 -- sequenceA :: - forall r ix e r' f. (Source r' ix (f e), Mutable r ix e, Applicative f) + forall r ix e r' f. (Source r' (f e), Mutable r e, Index ix, Applicative f) => Array r' ix (f e) -> f (Array r ix e) sequenceA = traverseA id @@ -359,7 +373,10 @@ sequenceA = traverseA id -- -- @since 0.3.0 -- -sequenceA_ :: forall r ix e f . (Source r ix (f e), Applicative f) => Array r ix (f e) -> f () +sequenceA_ :: + forall r ix e f. (Index ix, Source r (f e), Applicative f) + => Array r ix (f e) + -> f () sequenceA_ = traverseA_ id {-# INLINE sequenceA_ #-} @@ -369,7 +386,7 @@ sequenceA_ = traverseA_ id -- @since 0.2.6 -- itraverseA :: - forall r ix e r' a f . (Source r' ix a, Mutable r ix e, Applicative f) + forall r ix e r' a f . (Source r' a, Mutable r e, Index ix, Applicative f) => (ix -> a -> f e) -> Array r' ix a -> f (Array r ix e) @@ -383,7 +400,7 @@ itraverseA f arr = -- @since 0.2.6 -- itraverseA_ :: - forall r ix e a f. (Source r ix a, Applicative f) + forall r ix e a f. (Source r a, Index ix, Applicative f) => (ix -> a -> f e) -> Array r ix a -> f () @@ -399,7 +416,7 @@ itraverseA_ f arr = -- @since 0.3.0 -- traversePrim :: - forall r ix b r' a m . (Source r' ix a, Mutable r ix b, PrimMonad m) + forall r ix b r' a m . (Source r' a, Mutable r b, Index ix, PrimMonad m) => (a -> m b) -> Array r' ix a -> m (Array r ix b) @@ -411,7 +428,7 @@ traversePrim f = itraversePrim (const f) -- @since 0.3.0 -- itraversePrim :: - forall r ix b r' a m . (Source r' ix a, Mutable r ix b, PrimMonad m) + forall r ix b r' a m . (Source r' a, Mutable r b, Index ix, PrimMonad m) => (ix -> a -> m b) -> Array r' ix a -> m (Array r ix b) @@ -432,7 +449,7 @@ itraversePrim f arr = -- -- @since 0.2.6 mapM :: - forall r ix b r' a m. (Source r' ix a, Mutable r ix b, Monad m) + forall r ix b r' a m. (Source r' a, Mutable r b, Index ix, Monad m) => (a -> m b) -- ^ Mapping action -> Array r' ix a -- ^ Source array -> m (Array r ix b) @@ -444,7 +461,7 @@ mapM = traverseA -- -- @since 0.2.6 forM :: - forall r ix b r' a m. (Source r' ix a, Mutable r ix b, Monad m) + forall r ix b r' a m. (Source r' a, Mutable r b, Index ix, Monad m) => Array r' ix a -> (a -> m b) -> m (Array r ix b) @@ -456,7 +473,7 @@ forM = flip traverseA -- -- @since 0.2.6 imapM :: - forall r ix b r' a m. (Source r' ix a, Mutable r ix b, Monad m) + forall r ix b r' a m. (Source r' a, Mutable r b, Index ix, Monad m) => (ix -> a -> m b) -> Array r' ix a -> m (Array r ix b) @@ -468,7 +485,7 @@ imapM = itraverseA -- -- @since 0.5.1 iforM :: - forall r ix b r' a m. (Source r' ix a, Mutable r ix b, Monad m) + forall r ix b r' a m. (Source r' a, Mutable r b, Index ix, Monad m) => Array r' ix a -> (ix -> a -> m b) -> m (Array r ix b) @@ -489,7 +506,7 @@ iforM = flip itraverseA -- 58 -- -- @since 0.1.0 -mapM_ :: (Source r ix a, Monad m) => (a -> m b) -> Array r ix a -> m () +mapM_ :: (Source r a, Index ix, Monad m) => (a -> m b) -> Array r ix a -> m () mapM_ f !arr = iterM_ zeroIndex (unSz (size arr)) (pureIndex 1) (<) (f . unsafeIndex arr) {-# INLINE mapM_ #-} @@ -508,13 +525,13 @@ mapM_ f !arr = iterM_ zeroIndex (unSz (size arr)) (pureIndex 1) (<) (f . unsafeI -- >>> readIORef ref -- 499500 -- -forM_ :: (Source r ix a, Monad m) => Array r ix a -> (a -> m b) -> m () +forM_ :: (Source r a, Index ix, Monad m) => Array r ix a -> (a -> m b) -> m () forM_ = flip mapM_ {-# INLINE forM_ #-} -- | Just like `imapM_`, except with flipped arguments. -iforM_ :: (Source r ix a, Monad m) => Array r ix a -> (ix -> a -> m b) -> m () +iforM_ :: (Source r a, Index ix, Monad m) => Array r ix a -> (ix -> a -> m b) -> m () iforM_ = flip imapM_ {-# INLINE iforM_ #-} @@ -525,7 +542,7 @@ iforM_ = flip imapM_ -- -- @since 0.2.6 mapIO :: - forall r ix b r' a m. (Source r' ix a, Mutable r ix b, MonadUnliftIO m, PrimMonad m) + forall r ix b r' a m. (Source r' a, Mutable r b, Index ix, MonadUnliftIO m, PrimMonad m) => (a -> m b) -> Array r' ix a -> m (Array r ix b) @@ -536,14 +553,14 @@ mapIO action = imapIO (const action) -- array, therefore it is faster. Use this instead of `mapIO` when result is irrelevant. -- -- @since 0.2.6 -mapIO_ :: (Source r b e, MonadUnliftIO m) => (e -> m a) -> Array r b e -> m () +mapIO_ :: (Index ix, Source r e, MonadUnliftIO m) => (e -> m a) -> Array r ix e -> m () mapIO_ action = imapIO_ (const action) {-# INLINE mapIO_ #-} -- | Same as `mapIO_`, but map an index aware action instead. -- -- @since 0.2.6 -imapIO_ :: (Source r ix e, MonadUnliftIO m) => (ix -> e -> m a) -> Array r ix e -> m () +imapIO_ :: (Index ix, Source r e, MonadUnliftIO m) => (ix -> e -> m a) -> Array r ix e -> m () imapIO_ action arr = withScheduler_ (getComp arr) $ \scheduler -> imapSchedulerM_ scheduler action arr {-# INLINE imapIO_ #-} @@ -552,7 +569,7 @@ imapIO_ action arr = -- -- @since 0.3.1 imapSchedulerM_ :: - (Source r ix e, Monad m) => Scheduler m () -> (ix -> e -> m a) -> Array r ix e -> m () + (Index ix, Source r e, Monad m) => Scheduler m () -> (ix -> e -> m a) -> Array r ix e -> m () imapSchedulerM_ scheduler action arr = do let sz = size arr splitLinearlyWith_ @@ -567,7 +584,7 @@ imapSchedulerM_ scheduler action arr = do -- -- @since 0.3.1 iforSchedulerM_ :: - (Source r ix e, Monad m) => Scheduler m () -> Array r ix e -> (ix -> e -> m a) -> m () + (Index ix, Source r e, Monad m) => Scheduler m () -> Array r ix e -> (ix -> e -> m a) -> m () iforSchedulerM_ scheduler arr action = imapSchedulerM_ scheduler action arr {-# INLINE iforSchedulerM_ #-} @@ -576,7 +593,7 @@ iforSchedulerM_ scheduler arr action = imapSchedulerM_ scheduler action arr -- -- @since 0.2.6 imapIO :: - forall r ix b r' a m. (Source r' ix a, Mutable r ix b, MonadUnliftIO m, PrimMonad m) + forall r ix b r' a m. (Source r' a, Mutable r b, Index ix, MonadUnliftIO m, PrimMonad m) => (ix -> a -> m b) -> Array r' ix a -> m (Array r ix b) @@ -587,7 +604,7 @@ imapIO action arr = generateArray (getComp arr) (size arr) $ \ix -> action ix (u -- -- @since 0.2.6 forIO :: - forall r ix b r' a m. (Source r' ix a, Mutable r ix b, MonadUnliftIO m, PrimMonad m) + forall r ix b r' a m. (Source r' a, Mutable r b, Index ix, MonadUnliftIO m, PrimMonad m) => Array r' ix a -> (a -> m b) -> m (Array r ix b) @@ -602,7 +619,7 @@ forIO = flip mapIO -- -- @since 0.3.4 imapWS :: - forall r ix b r' a s m. (Source r' ix a, Mutable r ix b, MonadUnliftIO m, PrimMonad m) + forall r ix b r' a s m. (Source r' a, Mutable r b, Index ix, MonadUnliftIO m, PrimMonad m) => WorkerStates s -> (ix -> a -> s -> m b) -> Array r' ix a @@ -614,7 +631,7 @@ imapWS states f arr = generateArrayWS states (size arr) (\ix s -> f ix (unsafeIn -- -- @since 0.3.4 mapWS :: - forall r ix b r' a s m. (Source r' ix a, Mutable r ix b, MonadUnliftIO m, PrimMonad m) + forall r ix b r' a s m. (Source r' a, Mutable r b, Index ix, MonadUnliftIO m, PrimMonad m) => WorkerStates s -> (a -> s -> m b) -> Array r' ix a @@ -627,7 +644,7 @@ mapWS states f = imapWS states (\ _ -> f) -- -- @since 0.3.4 iforWS :: - forall r ix b r' a s m. (Source r' ix a, Mutable r ix b, MonadUnliftIO m, PrimMonad m) + forall r ix b r' a s m. (Source r' a, Mutable r b, Index ix, MonadUnliftIO m, PrimMonad m) => WorkerStates s -> Array r' ix a -> (ix -> a -> s -> m b) @@ -639,7 +656,7 @@ iforWS states f arr = imapWS states arr f -- -- @since 0.3.4 forWS :: - forall r ix b r' a s m. (Source r' ix a, Mutable r ix b, MonadUnliftIO m, PrimMonad m) + forall r ix b r' a s m. (Source r' a, Mutable r b, Index ix, MonadUnliftIO m, PrimMonad m) => WorkerStates s -> Array r' ix a -> (a -> s -> m b) @@ -664,7 +681,7 @@ forWS states arr f = imapWS states (\ _ -> f) arr -- 499500 -- -- @since 0.2.6 -forIO_ :: (Source r ix e, MonadUnliftIO m) => Array r ix e -> (e -> m a) -> m () +forIO_ :: (Index ix, Source r e, MonadUnliftIO m) => Array r ix e -> (e -> m a) -> m () forIO_ = flip mapIO_ {-# INLINE forIO_ #-} @@ -672,7 +689,7 @@ forIO_ = flip mapIO_ -- -- @since 0.2.6 iforIO :: - forall r ix b r' a m. (Source r' ix a, Mutable r ix b, MonadUnliftIO m, PrimMonad m) + forall r ix b r' a m. (Source r' a, Mutable r b, Index ix, MonadUnliftIO m, PrimMonad m) => Array r' ix a -> (ix -> a -> m b) -> m (Array r ix b) @@ -682,6 +699,6 @@ iforIO = flip imapIO -- | Same as `imapIO_` but with arguments flipped. -- -- @since 0.2.6 -iforIO_ :: (Source r ix a, MonadUnliftIO m) => Array r ix a -> (ix -> a -> m b) -> m () +iforIO_ :: (Source r a, Index ix, MonadUnliftIO m) => Array r ix a -> (ix -> a -> m b) -> m () iforIO_ = flip imapIO_ {-# INLINE iforIO_ #-} diff --git a/massiv/src/Data/Massiv/Array/Ops/Sort.hs b/massiv/src/Data/Massiv/Array/Ops/Sort.hs index 9711415b..efdb4ca8 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Sort.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Sort.hs @@ -44,7 +44,7 @@ import System.IO.Unsafe -- [ (1,1), (2,3), (3,1), (4,2), (5,1) ] -- -- @since 0.4.4 -tally :: (Mutable r Ix1 e, Resize r ix, Load r ix e, Ord e) => Array r ix e -> Vector DS (e, Int) +tally :: (Mutable r e, Load r ix e, Ord e) => Array r ix e -> Vector DS (e, Int) tally arr | isEmpty arr = setComp (getComp arr) empty | otherwise = scatMaybes $ sunfoldrN (sz + 1) count (0, 0, sorted ! 0) @@ -62,14 +62,18 @@ tally arr {-# INLINE tally #-} -unsafeUnstablePartitionRegionM' :: - forall r e m. (Mutable r Ix1 e, PrimMonad m) - => MArray (PrimState m) r Ix1 e + +-- | Partition a segment of a vector. Starting and ending indices are unchecked. +-- +-- @since 1.0.0 +unsafeUnstablePartitionRegionM :: + forall r e m. (Mutable r e, PrimMonad m) + => MVector (PrimState m) r e -> (e -> m Bool) -> Ix1 -- ^ Start index of the region -> Ix1 -- ^ End index of the region -> m Ix1 -unsafeUnstablePartitionRegionM' marr f start end = fromLeft start (end + 1) +unsafeUnstablePartitionRegionM marr f start end = fromLeft start (end + 1) where fromLeft i j | i == j = pure i @@ -89,21 +93,6 @@ unsafeUnstablePartitionRegionM' marr f start end = fromLeft start (end + 1) unsafeLinearWrite marr i x fromLeft (i + 1) j else fromRight i (j - 1) -{-# INLINE unsafeUnstablePartitionRegionM' #-} - - --- TODO: Replace `unsafeUnstablePartitionRegionM` with `unsafeUnstablePartitionRegionM'` --- | Partition a segment of a vector. Starting and ending indices are unchecked. --- --- @since 0.3.2 -unsafeUnstablePartitionRegionM :: - forall r e m. (Mutable r Ix1 e, PrimMonad m) - => MVector (PrimState m) r e - -> (e -> Bool) - -> Ix1 -- ^ Start index of the region - -> Ix1 -- ^ End index of the region - -> m Ix1 -unsafeUnstablePartitionRegionM marr f = unsafeUnstablePartitionRegionM' marr (pure . f) {-# INLINE unsafeUnstablePartitionRegionM #-} @@ -115,7 +104,7 @@ unsafeUnstablePartitionRegionM marr f = unsafeUnstablePartitionRegionM' marr (pu -- -- @since 0.3.2 quicksort :: - (Mutable r Ix1 e, Ord e) => Array r Ix1 e -> Array r Ix1 e + (Mutable r e, Ord e) => Vector r e -> Vector r e quicksort arr = unsafePerformIO $ withMArray_ arr quicksortM_ {-# INLINE quicksort #-} @@ -124,15 +113,14 @@ quicksort arr = unsafePerformIO $ withMArray_ arr quicksortM_ -- -- @since 0.6.1 quicksortByM :: - (Mutable r Ix1 e, MonadUnliftIO m) => (e -> e -> m Ordering) -> Vector r e -> m (Vector r e) + (Mutable r e, MonadUnliftIO m) => (e -> e -> m Ordering) -> Vector r e -> m (Vector r e) quicksortByM f arr = withRunInIO $ \run -> withMArray_ arr (quicksortByM_ (\x y -> run (f x y))) {-# INLINE quicksortByM #-} -- | Same as `quicksortBy`, but instead of `Ord` constraint expects a custom `Ordering`. -- -- @since 0.6.1 -quicksortBy :: - (Mutable r Ix1 e) => (e -> e -> Ordering) -> Vector r e -> Vector r e +quicksortBy :: Mutable r e => (e -> e -> Ordering) -> Vector r e -> Vector r e quicksortBy f arr = unsafePerformIO $ withMArray_ arr (quicksortByM_ (\x y -> pure $ f x y)) {-# INLINE quicksortBy #-} @@ -141,7 +129,7 @@ quicksortBy f arr = -- -- @since 0.3.2 quicksortM_ :: - (Ord e, Mutable r Ix1 e, PrimMonad m) + (Ord e, Mutable r e, PrimMonad m) => Scheduler m () -> MVector (PrimState m) r e -> m () @@ -153,7 +141,7 @@ quicksortM_ = quicksortInternalM_ (\e1 e2 -> pure $ e1 < e2) (\e1 e2 -> pure $ e -- -- @since 0.6.1 quicksortByM_ :: - (Mutable r Ix1 e, PrimMonad m) + (Mutable r e, PrimMonad m) => (e -> e -> m Ordering) -> Scheduler m () -> MVector (PrimState m) r e @@ -164,7 +152,7 @@ quicksortByM_ compareM = quicksortInternalM_ :: - (Mutable r Ix1 e, PrimMonad m) + (Mutable r e, PrimMonad m) => (e -> e -> m Bool) -> (e -> e -> m Bool) -> Scheduler m () @@ -193,8 +181,8 @@ quicksortInternalM_ fLT fEQ scheduler marr = qsort !n !lo !hi = when (lo < hi) $ do p <- getPivot lo hi - l <- unsafeUnstablePartitionRegionM' marr (`fLT` p) lo (hi - 1) - h <- unsafeUnstablePartitionRegionM' marr (`fEQ` p) l hi + l <- unsafeUnstablePartitionRegionM marr (`fLT` p) lo (hi - 1) + h <- unsafeUnstablePartitionRegionM marr (`fEQ` p) l hi if n > 0 then do let !n' = n - 1 diff --git a/massiv/src/Data/Massiv/Array/Ops/Transform.hs b/massiv/src/Data/Massiv/Array/Ops/Transform.hs index d77a8cc2..20f3deb9 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Transform.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Transform.hs @@ -137,7 +137,7 @@ extractFromTo' sIx eIx = extract' sIx $ Sz (liftIndex2 (-) eIx sIx) -- -- @since 0.3.0 resizeM :: - (MonadThrow m, Index ix', Load r ix e, Resize r ix) + (MonadThrow m, Index ix', Index ix, Resize r) => Sz ix' -> Array r ix e -> m (Array r ix' e) @@ -147,14 +147,14 @@ resizeM sz arr = guardNumberOfElements (size arr) sz >> pure (unsafeResize sz ar -- | Same as `resizeM`, but will throw an error if supplied dimensions are incorrect. -- -- @since 0.1.0 -resize' :: (Index ix', Load r ix e, Resize r ix) => Sz ix' -> Array r ix e -> Array r ix' e +resize' :: (Index ix', Index ix, Resize r) => Sz ix' -> Array r ix e -> Array r ix' e resize' sz = either throw id . resizeM sz {-# INLINE resize' #-} -- | /O(1)/ - Reduce a multi-dimensional array into a flat vector -- -- @since 0.3.1 -flatten :: (Load r ix e, Resize r ix) => Array r ix e -> Array r Ix1 e +flatten :: (Index ix, Resize r) => Array r ix e -> Vector r e flatten arr = unsafeResize (SafeSz (totalElem (size arr))) arr {-# INLINE flatten #-} @@ -178,7 +178,7 @@ flatten arr = unsafeResize (SafeSz (totalElem (size arr))) arr -- ] -- -- @since 0.1.0 -transpose :: Source r Ix2 e => Array r Ix2 e -> Array D Ix2 e +transpose :: Source r e => Matrix r e -> Matrix D e transpose = transposeInner {-# INLINE [1] transpose #-} @@ -220,8 +220,8 @@ transpose = transposeInner -- ] -- -- @since 0.1.0 -transposeInner :: (Index (Lower ix), Source r' ix e) - => Array r' ix e -> Array D ix e +transposeInner :: (Index (Lower ix), Index ix, Source r e) + => Array r ix e -> Array D ix e transposeInner !arr = makeArray (getComp arr) newsz newVal where transInner !ix = @@ -271,8 +271,8 @@ transposeInner !arr = makeArray (getComp arr) newsz newVal -- -- -- @since 0.1.0 -transposeOuter :: (Index (Lower ix), Source r' ix e) - => Array r' ix e -> Array D ix e +transposeOuter :: (Index (Lower ix), Index ix, Source r e) + => Array r ix e -> Array D ix e transposeOuter !arr = makeArray (getComp arr) newsz newVal where transOuter !ix = @@ -316,7 +316,7 @@ transposeOuter !arr = makeArray (getComp arr) newsz newVal -- ] -- -- @since 0.4.1 -reverse :: (IsIndexDimension ix n, Source r ix e) => Dimension n -> Array r ix e -> Array D ix e +reverse :: (IsIndexDimension ix n, Index ix, Source r e) => Dimension n -> Array r ix e -> Array D ix e reverse dim = reverse' (fromDimension dim) {-# INLINE reverse #-} @@ -324,7 +324,7 @@ reverse dim = reverse' (fromDimension dim) -- `IndexDimensionException` for an incorrect dimension. -- -- @since 0.4.1 -reverseM :: (MonadThrow m, Source r ix e) => Dim -> Array r ix e -> m (Array D ix e) +reverseM :: (MonadThrow m, Index ix, Source r e) => Dim -> Array r ix e -> m (Array D ix e) reverseM dim arr = do let sz = size arr k <- getDimM (unSz sz) dim @@ -336,7 +336,7 @@ reverseM dim arr = do -- `IndexDimensionException` from pure code. -- -- @since 0.4.1 -reverse' :: Source r ix e => Dim -> Array r ix e -> Array D ix e +reverse' :: (Index ix, Source r e) => Dim -> Array r ix e -> Array D ix e reverse' dim = either throw id . reverseM dim {-# INLINE reverse' #-} @@ -370,7 +370,7 @@ reverse' dim = either throw id . reverseM dim -- @since 0.3.0 backpermuteM :: forall r ix e r' ix' m. - (Mutable r ix e, Source r' ix' e, MonadUnliftIO m, PrimMonad m, MonadThrow m) + (Mutable r e, Index ix, Source r' e, Index ix', MonadUnliftIO m, PrimMonad m, MonadThrow m) => Sz ix -- ^ Size of the result array -> (ix -> ix') -- ^ A function that maps indices of the new array into the source one. -> Array r' ix' e -- ^ Source array. @@ -385,11 +385,11 @@ backpermuteM sz ixF !arr = generateArray (getComp arr) sz (evaluateM arr . ixF) -- * Throws a runtime `IndexOutOfBoundsException` from pure code. -- -- @since 0.3.0 -backpermute' :: (Source r' ix' e, Index ix) => - Sz ix -- ^ Size of the result array - -> (ix -> ix') -- ^ A function that maps indices of the new array into the source one. - -> Array r' ix' e -- ^ Source array. - -> Array D ix e +backpermute' :: (Source r e, Index ix, Index ix') => + Sz ix' -- ^ Size of the result array + -> (ix' -> ix) -- ^ A function that maps indices of the new array into the source one. + -> Array r ix e -- ^ Source array. + -> Array D ix' e backpermute' sz ixF !arr = makeArray (getComp arr) sz (evaluate' arr . ixF) {-# INLINE backpermute' #-} @@ -431,7 +431,7 @@ backpermute' sz ixF !arr = makeArray (getComp arr) sz (evaluate' arr . ixF) -- -- @since 0.3.0 appendM :: - forall r1 r2 ix e m. (MonadThrow m, Source r1 ix e, Source r2 ix e) + forall r1 r2 ix e m. (MonadThrow m, Index ix, Source r1 e, Source r2 e) => Dim -> Array r1 ix e -> Array r2 ix e @@ -465,7 +465,7 @@ appendM n !arr1 !arr2 = do -- | Same as `appendM`, but will throw an exception in pure code on mismatched sizes. -- -- @since 0.3.0 -append' :: (Source r1 ix e, Source r2 ix e) => +append' :: (Index ix, Source r1 e, Source r2 e) => Dim -> Array r1 ix e -> Array r2 ix e -> Array DL ix e append' dim arr1 arr2 = either throw id $ appendM dim arr1 arr2 {-# INLINE append' #-} @@ -473,7 +473,7 @@ append' dim arr1 arr2 = either throw id $ appendM dim arr1 arr2 -- | Concat many arrays together along some dimension. -- -- @since 0.3.0 -concat' :: (Foldable f, Source r ix e) => Dim -> f (Array r ix e) -> Array DL ix e +concat' :: (Foldable f, Index ix, Source r e) => Dim -> f (Array r ix e) -> Array DL ix e concat' n arrs = either throw id $ concatM n arrs {-# INLINE concat' #-} @@ -484,7 +484,7 @@ concat' n arrs = either throw id $ concatM n arrs -- -- @since 0.3.0 concatM :: - forall r ix e f m. (MonadThrow m, Foldable f, Source r ix e) + forall r ix e f m. (MonadThrow m, Foldable f, Index ix, Source r e) => Dim -> f (Array r ix e) -> m (Array DL ix e) @@ -585,7 +585,7 @@ concatM n !arrsF = -- -- @since 0.5.4 stackSlicesM :: - forall r ix e f m. (Foldable f, MonadThrow m, Source r (Lower ix) e, Index ix) + forall r ix e f m. (Foldable f, MonadThrow m, Index (Lower ix), Source r e, Index ix) => Dim -> f (Array r (Lower ix) e) -> m (Array DL ix e) @@ -645,7 +645,7 @@ stackSlicesM dim !arrsF = do -- -- @since 0.5.4 stackOuterSlicesM :: - forall r ix e f m. (Foldable f, MonadThrow m, Source r (Lower ix) e, Index ix) + forall r ix e f m. (Foldable f, MonadThrow m, Index (Lower ix), Source r e, Index ix) => f (Array r (Lower ix) e) -> m (Array DL ix e) stackOuterSlicesM = stackSlicesM (dimensions (Proxy :: Proxy ix)) @@ -685,7 +685,7 @@ stackOuterSlicesM = stackSlicesM (dimensions (Proxy :: Proxy ix)) -- -- @since 0.5.4 stackInnerSlicesM :: - forall r ix e f m. (Foldable f, MonadThrow m, Source r (Lower ix) e, Index ix) + forall r ix e f m. (Foldable f, MonadThrow m, Index (Lower ix), Source r e, Index ix) => f (Array r (Lower ix) e) -> m (Array DL ix e) stackInnerSlicesM = stackSlicesM 1 @@ -733,7 +733,7 @@ splitAt' dim i arr = either throw id $ splitAtM dim i arr -- -- @since 0.3.5 splitExtractM :: - (MonadThrow m, Extract r ix e, Source (R r) ix e) + (MonadThrow m, Extract r ix e, Source (R r) e) => Dim -- ^ Dimension along which to do the extraction -> Ix1 -- ^ Start index along the dimension that needs to be extracted -> Sz Ix1 -- ^ Size of the extracted array along the dimension that it will be extracted @@ -783,9 +783,9 @@ splitExtractM dim startIx1 (Sz extractSzIx1) arr = do replaceSlice :: ( MonadThrow m , Extract r ix e - , Source (R r) ix e + , Source (R r) e , Load (R r) (Lower ix) e - , Resize (R r) (Lower ix) + , Resize (R r) ) => Dim -> Ix1 @@ -829,9 +829,9 @@ replaceSlice dim i sl arr = do replaceOuterSlice :: ( MonadThrow m , Extract r ix e - , Source (R r) ix e + , Source (R r) e , Load (R r) (Lower ix) e - , Resize (R r) (Lower ix) + , Resize (R r) ) => Ix1 -> Array (R r) (Lower ix) e @@ -866,7 +866,7 @@ replaceOuterSlice i sl arr = replaceSlice (dimensions (size arr)) i sl arr -- -- @since 0.3.5 deleteRegionM :: - (MonadThrow m, Extract r ix e, Source (R r) ix e) + (MonadThrow m, Extract r ix e, Source (R r) e) => Dim -- ^ Along which axis should the removal happen -> Ix1 -- ^ At which index to start dropping slices -> Sz Ix1 -- ^ Number of slices to drop @@ -898,7 +898,7 @@ deleteRegionM dim ix sz arr = do -- -- @since 0.3.5 deleteRowsM :: - (MonadThrow m, Extract r ix e, Source (R r) ix e, Index (Lower ix)) + (MonadThrow m, Extract r ix e, Source (R r) e, Index (Lower ix)) => Ix1 -> Sz Ix1 -> Array r ix e @@ -927,7 +927,7 @@ deleteRowsM = deleteRegionM 2 -- -- @since 0.3.5 deleteColumnsM :: - (MonadThrow m, Extract r ix e, Source (R r) ix e) + (MonadThrow m, Extract r ix e, Source (R r) e) => Ix1 -> Sz Ix1 -> Array r ix e @@ -940,7 +940,7 @@ deleteColumnsM = deleteRegionM 1 -- -- @since 0.3.0 downsample :: - forall r ix e. Source r ix e + forall r ix e. (Source r e, Load r ix e) => Stride ix -> Array r ix e -> Array DL ix e @@ -995,7 +995,7 @@ downsample stride arr = -- -- @since 0.3.0 upsample :: - forall r ix e. Load r ix e + forall r ix e. (Resize r, Load r ix e) => e -- ^ Element to use for filling the newly added cells -> Stride ix -- ^ Fill cells according to this stride -> Array r ix e -- ^ Array that will have cells added to @@ -1028,7 +1028,7 @@ upsample !fillWith safeStride arr = -- @since 0.3.0 transformM :: forall r ix e r' ix' e' a m. - (Mutable r ix e, Source r' ix' e', MonadUnliftIO m, PrimMonad m, MonadThrow m) + (Mutable r e, Index ix, Source r' e', Index ix', MonadUnliftIO m, PrimMonad m, MonadThrow m) => (Sz ix' -> m (Sz ix, a)) -> (a -> (ix' -> m e') -> ix -> m e) -> Array r' ix' e' @@ -1043,7 +1043,7 @@ transformM getSzM getM arr = do -- -- @since 0.3.0 transform' :: - (Source r' ix' e', Index ix) + (Source r' e', Index ix', Index ix) => (Sz ix' -> (Sz ix, a)) -> (a -> (ix' -> e') -> ix -> e) -> Array r' ix' e' @@ -1057,7 +1057,16 @@ transform' getSz get arr = makeArray (getComp arr) sz (get a (evaluate' arr)) -- -- @since 0.3.0 transform2M :: - (Mutable r ix e, Source r1 ix1 e1, Source r2 ix2 e2, MonadUnliftIO m, PrimMonad m, MonadThrow m) + ( Mutable r e + , Index ix + , Source r1 e1 + , Source r2 e2 + , Index ix1 + , Index ix2 + , MonadUnliftIO m + , PrimMonad m + , MonadThrow m + ) => (Sz ix1 -> Sz ix2 -> m (Sz ix, a)) -> (a -> (ix1 -> m e1) -> (ix2 -> m e2) -> ix -> m e) -> Array r1 ix1 e1 @@ -1073,7 +1082,7 @@ transform2M getSzM getM arr1 arr2 = do -- -- @since 0.3.0 transform2' :: - (Source r1 ix1 e1, Source r2 ix2 e2, Index ix) + (Source r1 e1, Source r2 e2, Index ix, Index ix1, Index ix2) => (Sz ix1 -> Sz ix2 -> (Sz ix, a)) -> (a -> (ix1 -> e1) -> (ix2 -> e2) -> ix -> e) -> Array r1 ix1 e1 @@ -1118,7 +1127,7 @@ transform2' getSz get arr1 arr2 = -- -- @since 0.3.1 zoomWithGrid :: - forall r ix e. Source r ix e + forall r ix e. (Index ix, Source r e) => e -- ^ Value to use for the grid -> Stride ix -- ^ Scaling factor -> Array r ix e -- ^ Source array @@ -1172,7 +1181,7 @@ zoomWithGrid gridVal (Stride zoomFactor) arr = unsafeMakeLoadArray Seq newSz (Ju -- -- @since 0.4.4 zoom :: - forall r ix e. Source r ix e + forall r ix e. (Index ix, Source r e) => Stride ix -- ^ Scaling factor -> Array r ix e -- ^ Source array -> Array DL ix e diff --git a/massiv/src/Data/Massiv/Array/Stencil.hs b/massiv/src/Data/Massiv/Array/Stencil.hs index 4e057b9a..86362f73 100644 --- a/massiv/src/Data/Massiv/Array/Stencil.hs +++ b/massiv/src/Data/Massiv/Array/Stencil.hs @@ -70,7 +70,7 @@ getStencilCenter = stencilCenter -- -- @since 0.1.0 mapStencil :: - (Source r ix e, Manifest r ix e) + (Index ix, Manifest r e) => Border e -- ^ Border resolution technique -> Stencil ix e a -- ^ Stencil to map over the array -> Array r ix e -- ^ Source array @@ -179,7 +179,7 @@ samePadding (Stencil (Sz sSz) sCenter _) border = -- -- @since 0.4.3 applyStencil :: - (Source r ix e, Manifest r ix e) + (Index ix, Manifest r e) => Padding ix e -- ^ Padding to be applied to the source array. This will dictate the resulting size of -- the array. No padding will cause it to shrink by the size of the stencil diff --git a/massiv/src/Data/Massiv/Array/Stencil/Convolution.hs b/massiv/src/Data/Massiv/Array/Stencil/Convolution.hs index 878ee90c..429d6b40 100644 --- a/massiv/src/Data/Massiv/Array/Stencil/Convolution.hs +++ b/massiv/src/Data/Massiv/Array/Stencil/Convolution.hs @@ -61,7 +61,7 @@ makeConvolutionStencil !sz !sCenter relStencil = -- -- @since 0.1.0 makeConvolutionStencilFromKernel - :: (Manifest r ix e, Num e) + :: (Manifest r e, Index ix, Num e) => Array r ix e -> Stencil ix e e makeConvolutionStencilFromKernel kArr = Stencil sz sInvertCenter stencil @@ -104,7 +104,7 @@ makeCorrelationStencil !sSz !sCenter relStencil = Stencil sSz sCenter stencil -- -- @since 0.1.5 makeCorrelationStencilFromKernel - :: (Manifest r ix e, Num e) + :: (Manifest r e, Index ix, Num e) => Array r ix e -> Stencil ix e e makeCorrelationStencilFromKernel kArr = Stencil sz sCenter stencil diff --git a/massiv/src/Data/Massiv/Array/Stencil/Unsafe.hs b/massiv/src/Data/Massiv/Array/Stencil/Unsafe.hs index 640bb661..221d2917 100644 --- a/massiv/src/Data/Massiv/Array/Stencil/Unsafe.hs +++ b/massiv/src/Data/Massiv/Array/Stencil/Unsafe.hs @@ -17,47 +17,13 @@ module Data.Massiv.Array.Stencil.Unsafe , makeUnsafeConvolutionStencil , makeUnsafeCorrelationStencil , unsafeTransformStencil - -- ** Deprecated - , unsafeMapStencil ) where -import Data.Massiv.Array.Delayed.Windowed (Array(..), DW, Window(..), - insertWindow) import Data.Massiv.Array.Stencil.Internal import Data.Massiv.Core.Common import GHC.Exts (inline) --- | This is an unsafe version of `Data.Massiv.Array.Stencil.mapStencil`, which does not --- take a `Stencil`, but instead accepts all necessary information as separate arguments. --- --- @since 0.5.0 -unsafeMapStencil :: - Manifest r ix e - => Border e - -> Sz ix - -> ix - -> (ix -> (ix -> e) -> a) - -> Array r ix e - -> Array DW ix a -unsafeMapStencil b sSz sCenter stencilF !arr = insertWindow warr window - where - !warr = DArray (getComp arr) sz (stencil (borderIndex b arr)) - !window = - Window - { windowStart = sCenter - , windowSize = windowSz - , windowIndex = stencil (unsafeIndex arr) - , windowUnrollIx2 = unSz . fst <$> pullOutSzM sSz 2 - } - !sz = size arr - !windowSz = Sz (liftIndex2 (-) (unSz sz) (liftIndex (subtract 1) (unSz sSz))) - stencil getVal !ix = inline (stencilF ix) $ \ !ixD -> getVal (liftIndex2 (+) ix ixD) - {-# INLINE stencil #-} -{-# INLINE unsafeMapStencil #-} -{-# DEPRECATED unsafeMapStencil "In favor of `Data.Massiv.Array.mapStencil` that is applied to stencil created with `makeUnsafeStencil`" #-} - - -- | Similar to `Data.Massiv.Array.Stencil.makeStencil`, but there are no guarantees that the -- stencil will not read out of bounds memory. This stencil is also a bit more powerful in sense it -- gets an extra peice of information, namely the exact index for the element it is constructing. diff --git a/massiv/src/Data/Massiv/Array/Unsafe.hs b/massiv/src/Data/Massiv/Array/Unsafe.hs index cb1f63a6..c06c21cc 100644 --- a/massiv/src/Data/Massiv/Array/Unsafe.hs +++ b/massiv/src/Data/Massiv/Array/Unsafe.hs @@ -100,7 +100,7 @@ import Data.Massiv.Vector.Unsafe import Data.Massiv.Array.Stencil.Unsafe -unsafeBackpermute :: (Source r' ix' e, Index ix) => +unsafeBackpermute :: (Index ix', Source r' e, Index ix) => Sz ix -> (ix -> ix') -> Array r' ix' e -> Array D ix e unsafeBackpermute !sz ixF !arr = makeArray (getComp arr) sz $ \ !ix -> unsafeIndex arr (ixF ix) @@ -111,7 +111,7 @@ unsafeBackpermute !sz ixF !arr = -- -- @since 0.3.0 unsafeTransform :: - (Source r' ix' e', Index ix) + (Index ix', Source r' e', Index ix) => (Sz ix' -> (Sz ix, a)) -> (a -> (ix' -> e') -> ix -> e) -> Array r' ix' e' @@ -126,7 +126,7 @@ unsafeTransform getSz get arr = makeArray (getComp arr) sz (get a (unsafeIndex a -- -- @since 0.3.0 unsafeTransform2 :: - (Source r1 ix1 e1, Source r2 ix2 e2, Index ix) + (Index ix1, Source r1 e1, Index ix2, Source r2 e2, Index ix) => (Sz ix1 -> Sz ix2 -> (Sz ix, a)) -> (a -> (ix1 -> e1) -> (ix2 -> e2) -> ix -> e) -> Array r1 ix1 e1 diff --git a/massiv/src/Data/Massiv/Core.hs b/massiv/src/Data/Massiv/Core.hs index e288773d..7140e650 100644 --- a/massiv/src/Data/Massiv/Core.hs +++ b/massiv/src/Data/Massiv/Core.hs @@ -66,6 +66,6 @@ import Data.Massiv.Core.Operations (FoldNumeric, Numeric, NumericFloat) -- | Append computation strategy using `Comp`'s `Monoid` instance. -- -- @since 0.6.0 -appComp :: (Construct r ix e, Load r ix e) => Comp -> Array r ix e -> Array r ix e +appComp :: Strategy r => Comp -> Array r ix e -> Array r ix e appComp comp arr = setComp (comp <> getComp arr) arr {-# INLINEABLE appComp #-} diff --git a/massiv/src/Data/Massiv/Core/Common.hs b/massiv/src/Data/Massiv/Core/Common.hs index 5409a189..11d4119d 100644 --- a/massiv/src/Data/Massiv/Core/Common.hs +++ b/massiv/src/Data/Massiv/Core/Common.hs @@ -2,6 +2,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} @@ -22,10 +23,13 @@ module Data.Massiv.Core.Common , Elt , Steps(..) , Stream(..) + , Strategy(..) , Construct(..) , Source(..) , Load(..) , StrideLoad(..) + , Size(..) + , Shape(..) , Resize(..) , Extract(..) , Slice(..) @@ -54,10 +58,10 @@ module Data.Massiv.Core.Common , singleton -- * Size , elemsCount - , linearSize + , isNull , isNotEmpty , Sz(SafeSz) - , Size(..) + , LengthHint(..) -- * Indexing , (!?) , index @@ -69,6 +73,9 @@ module Data.Massiv.Core.Common , borderIndex , evaluateM , evaluate' + , inline0 + , inline1 + , inline2 , module Data.Massiv.Core.Index -- * Common Operations , imapM_ @@ -99,13 +106,13 @@ import Control.Monad.IO.Unlift (MonadIO(liftIO), MonadUnliftIO) import Control.Monad.Primitive import Control.Monad.ST import Control.Scheduler (Comp(..), Scheduler, WorkerStates, numWorkers, - scheduleWork, scheduleWork_, withScheduler_, trivialScheduler_) + scheduleWork, scheduleWork_, trivialScheduler_, + withScheduler_) import Control.Scheduler.Global import Data.Massiv.Core.Exception import Data.Massiv.Core.Index import Data.Massiv.Core.Index.Internal (Sz(SafeSz)) import Data.Typeable -import Data.Vector.Fusion.Bundle.Size import qualified Data.Vector.Fusion.Stream.Monadic as S (Stream) import Data.Vector.Fusion.Util @@ -157,14 +164,10 @@ class Load r ix e => Stream r ix e where data Steps m e = Steps { stepsStream :: S.Stream m e - , stepsSize :: Size + , stepsSize :: LengthHint } - --- | Array types that can be constructed. -class (Typeable r, Index ix) => Construct r ix e where - {-# MINIMAL setComp,(makeArray|makeArrayLinear) #-} - +class Typeable r => Strategy r where -- | Set computation strategy for this array -- -- ==== __Example__ @@ -181,6 +184,17 @@ class (Typeable r, Index ix) => Construct r ix e where -- setComp :: Comp -> Array r ix e -> Array r ix e + -- | Get computation strategy of this array + -- + -- @since 0.1.0 + getComp :: Array r ix e -> Comp + +-- TODO: rename to ConstructP + +-- | Array types that can be constructed. +class Load r ix e => Construct r ix e where + {-# MINIMAL (makeArray|makeArrayLinear) #-} + -- | Construct an Array. Resulting type either has to be unambiguously inferred or restricted -- manually, like in the example below. Use "Data.Massiv.Array.makeArrayR" if you'd like to -- specify representation as an argument. @@ -226,33 +240,119 @@ class (Typeable r, Index ix) => Construct r ix e where makeArrayLinear comp sz f = makeArray comp sz (f . toLinearIndex sz) {-# INLINE makeArrayLinear #-} + replicate :: Comp -> Sz ix -> e -> Array r ix e replicate comp sz !e = makeArray comp sz (const e) {-# INLINE replicate #-} -class Index ix => Resize r ix where + +-- | Size hint +-- +-- @since 0.6.0 +data LengthHint + = LengthExact Sz1 -- ^ Exact known size + | LengthMax Sz1 -- ^ Upper bound on the size + | LengthUnknown -- ^ Unknown size + deriving (Eq, Show) + + +-- | A shape of an array. +-- +-- @since 0.6.0 +class Index ix => Shape r ix where + + -- | /O(1)/ - Check what do we know about the number of elements without doing any work + -- + -- @since 0.6.0 + linearSizeHint :: Array r ix e -> LengthHint + default linearSizeHint :: Size r => Array r ix e -> LengthHint + linearSizeHint = LengthExact . SafeSz . elemsCount + {-# INLINE linearSizeHint #-} + + -- | /O(n)/ - possibly iterate over the whole array before producing the answer + -- + -- @since 0.5.8 + linearSize :: Array r ix e -> Sz1 + default linearSize :: Size r => Array r ix e -> Sz1 + linearSize = SafeSz . elemsCount + {-# INLINE linearSize #-} + + -- | /O(n)/ - Rectangular size of an array that is inferred from looking at the first row in + -- each dimensions. For rectangular arrays this is the same as `size` + -- + -- @since 0.6.0 + outerSize :: Array r ix e -> Sz ix + default outerSize :: Size r => Array r ix e -> Sz ix + outerSize = size + {-# INLINE outerSize #-} + + -- | /O(1)/ - Get the possible maximum linear size of an immutabe array. If the lookup + -- of size in constant time is not possible, `Nothing` will be returned. This value + -- will be used as the initial size of the mutable array into which the loading will + -- happen. + -- + -- @since 0.6.0 + maxLinearSize :: Array r ix e -> Maybe Sz1 + maxLinearSize = lengthHintUpperBound . linearSizeHint + {-# INLINE maxLinearSize #-} + + -- | /O(1)/ - Check if an array has no elements. + -- + -- ==== __Examples__ + -- + -- >>> import Data.Massiv.Array + -- >>> isEmpty $ range Seq (Ix2 10 20) (11 :. 21) + -- False + -- >>> isEmpty $ range Seq (Ix2 10 20) (10 :. 21) + -- True + -- + -- @since 0.1.0 + isEmpty :: Array r ix e -> Bool + isEmpty = (0 ==) . linearSize + {-# INLINE isEmpty #-} + + +lengthHintUpperBound :: LengthHint -> Maybe Sz1 +lengthHintUpperBound = \case + LengthExact sz -> Just sz + LengthMax sz -> Just sz + LengthUnknown -> Nothing +{-# INLINE lengthHintUpperBound #-} + + +class Size r where + + -- | Get the exact size of an immutabe array. Most of the time will produce the size in + -- constant time, except for `DS` representation, which could result in evaluation of + -- the whole stream. See `maxSize` and `Data.Massiv.Vector.slength` for more info. + -- + -- @since 0.1.0 + size :: Array r ix e -> Sz ix + +class Size r => Resize r where -- | /O(1)/ - Change the size of an array. Total number of elements should be the same, but it is -- not validated. - unsafeResize :: Index ix' => Sz ix' -> Array r ix e -> Array r ix' e + unsafeResize :: (Index ix, Index ix') => Sz ix' -> Array r ix e -> Array r ix' e + -class Load r ix e => Extract r ix e where +class (Size r, Index ix) => Extract r ix e where -- | /O(1)/ - Extract a portion of an array. Staring index and new size are -- not validated. unsafeExtract :: ix -> Sz ix -> Array r ix e -> Array (R r) ix e -- | Arrays that can be used as source to practically any manipulation function. -class (Resize r ix, Load r ix e) => Source r ix e where +class (Strategy r, Size r) => Source r e where {-# MINIMAL (unsafeIndex|unsafeLinearIndex), unsafeLinearSlice #-} -- | Lookup element in the array. No bounds check is performed and access of -- arbitrary memory is possible when invalid index is supplied. -- -- @since 0.1.0 - unsafeIndex :: Array r ix e -> ix -> e + unsafeIndex :: Index ix => Array r ix e -> ix -> e unsafeIndex = - INDEX_CHECK("(Source r ix e).unsafeIndex", + INDEX_CHECK("(Source r e).unsafeIndex", size, \ !arr -> unsafeLinearIndex arr . toLinearIndex (size arr)) {-# INLINE unsafeIndex #-} @@ -260,7 +360,7 @@ class (Resize r ix, Load r ix e) => Source r ix e where -- bounds check is performed -- -- @since 0.1.0 - unsafeLinearIndex :: Array r ix e -> Int -> e + unsafeLinearIndex :: Index ix => Array r ix e -> Int -> e unsafeLinearIndex !arr = unsafeIndex arr . fromLinearIndex (size arr) {-# INLINE unsafeLinearIndex #-} @@ -268,25 +368,13 @@ class (Resize r ix, Load r ix e) => Source r ix e where -- constant time -- -- @since 0.5.0 - unsafeLinearSlice :: Ix1 -> Sz1 -> Array r ix e -> Array r Ix1 e + unsafeLinearSlice :: Index ix => Ix1 -> Sz1 -> Array r ix e -> Array r Ix1 e -- | Any array that can be computed and loaded into memory -class (Typeable r, Index ix) => Load r ix e where +class (Strategy r, Shape r ix) => Load r ix e where type family R r :: * type instance R r = r - {-# MINIMAL getComp, size, (loadArrayM | loadArrayWithSetM) #-} - - -- | Get computation strategy of this array - -- - -- @since 0.1.0 - getComp :: Array r ix e -> Comp - - -- | Get the exact size of an immutabe array. Most of the time will produce the size in - -- constant time, except for `DS` representation, which could result in evaluation of - -- the whole stream. See `maxSize` and `Data.Massiv.Vector.slength` for more info. - -- - -- @since 0.1.0 - size :: Array r ix e -> Sz ix + {-# MINIMAL (loadArrayM | loadArrayWithSetM) #-} -- | Load an array into memory. -- @@ -318,57 +406,32 @@ class (Typeable r, Index ix) => Load r ix e where loadArrayWithSetM scheduler arr uWrite _ = loadArrayM scheduler arr uWrite {-# INLINE loadArrayWithSetM #-} - -- | /O(1)/ - Get the possible maximum size of an immutabe array. If the lookup of size - -- in constant time is not possible, `Nothing` will be returned. This value will be used - -- as the initial size of the mutable array into which the loading will happen. - -- - -- @since 0.5.0 - maxSize :: Array r ix e -> Maybe (Sz ix) - maxSize = Just . size - {-# INLINE maxSize #-} - - - -- | /O(1)/ - Check if an array has no elements. - -- - -- ==== __Examples__ - -- - -- >>> import Data.Massiv.Array - -- >>> isEmpty $ range Seq (Ix2 10 20) (11 :. 21) - -- False - -- >>> isEmpty $ range Seq (Ix2 10 20) (10 :. 21) - -- True - -- - -- @since 0.1.0 - isEmpty :: Array r ix e -> Bool - isEmpty !arr = 0 == elemsCount arr - {-# INLINE isEmpty #-} - -- | Load into a supplied mutable array sequentially. Returned array does not have to be -- the same -- -- @since 0.5.7 unsafeLoadIntoS :: - (Mutable r' ix e, PrimMonad m) - => MArray (PrimState m) r' ix e + (Mutable r' e, PrimMonad m) + => MVector (PrimState m) r' e -> Array r ix e -> m (MArray (PrimState m) r' ix e) unsafeLoadIntoS marr arr = - marr <$ loadArrayWithSetM trivialScheduler_ arr (unsafeLinearWrite marr) (unsafeLinearSet marr) + munsafeResize (outerSize arr) marr <$ loadArrayWithSetM trivialScheduler_ arr (unsafeLinearWrite marr) (unsafeLinearSet marr) {-# INLINE unsafeLoadIntoS #-} -- | Same as `unsafeLoadIntoS`, but respecting computation strategy. -- -- @since 0.5.7 unsafeLoadIntoM :: - (Mutable r' ix e, MonadIO m) - => MArray RealWorld r' ix e + (Mutable r' e, MonadIO m) + => MVector RealWorld r' e -> Array r ix e -> m (MArray RealWorld r' ix e) unsafeLoadIntoM marr arr = do liftIO $ withMassivScheduler_ (getComp arr) $ \scheduler -> loadArrayWithSetM scheduler arr (unsafeLinearWrite marr) (unsafeLinearSet marr) - pure marr + pure $ munsafeResize (outerSize arr) marr {-# INLINE unsafeLoadIntoM #-} -- | Selects an optimal scheduler for the supplied strategy, but it works only in `IO` @@ -377,9 +440,9 @@ withMassivScheduler_ comp f = case comp of Par -> withGlobalScheduler_ globalScheduler f Seq -> f trivialScheduler_ - _ -> withScheduler_ comp f + _ -> withScheduler_ comp f -class Load r ix e => StrideLoad r ix e where +class (Size r, Load r ix e) => StrideLoad r ix e where -- | Load an array into memory with stride. Default implementation requires an instance of -- `Source`. loadArrayWithStrideM @@ -391,7 +454,7 @@ class Load r ix e => StrideLoad r ix e where -> (Int -> e -> m ()) -- ^ Function that writes an element into target array -> m () default loadArrayWithStrideM - :: (Source r ix e, Monad m) => + :: (Source r e, Monad m) => Scheduler m () -> Stride ix -> Sz ix @@ -407,68 +470,87 @@ class Load r ix e => StrideLoad r ix e where {-# INLINE unsafeLinearWriteWithStride #-} {-# INLINE loadArrayWithStrideM #-} +-- class (Load r ix e) => StrideLoad r ix e where +-- class (Size r, StrideLoad r ix e) => StrideLoadP r ix e where + -- + -- unsafeLoadIntoWithStrideST :: + -- Mutable r' ix e + -- => Array r ix e + -- -> Stride ix -- ^ Stride to use + -- -> MArray RealWorld r' ix e + -- -> m (MArray RealWorld r' ix e) + + +--TODO: rethink Size here to support outer slicing (Something like OuterSize?) Affects +--only ragged arrays (L, LN and DS don't count, since they don't have constant time +--slicing anyways) -class Load r ix e => OuterSlice r ix e where +class (Size r, Load r ix e) => OuterSlice r ix e where -- | /O(1)/ - Take a slice out of an array from the outside unsafeOuterSlice :: Array r ix e -> Int -> Elt r ix e -class Load r ix e => InnerSlice r ix e where +class (Size r, Load r ix e) => InnerSlice r ix e where unsafeInnerSlice :: Array r ix e -> (Sz (Lower ix), Sz Int) -> Int -> Elt r ix e -class Load r ix e => Slice r ix e where +class (Size r, Load r ix e) => Slice r ix e where unsafeSlice :: MonadThrow m => Array r ix e -> ix -> Sz ix -> Dim -> m (Elt r ix e) -- | Manifest arrays are backed by actual memory and values are looked up versus -- computed as it is with delayed arrays. Because of this fact indexing functions -- @(`!`)@, @(`!?`)@, etc. are constrained to manifest arrays only. -class Source r ix e => Manifest r ix e where +class (Resize r, Source r e) => Manifest r e where - unsafeLinearIndexM :: Array r ix e -> Int -> e + unsafeLinearIndexM :: Index ix => Array r ix e -> Int -> e -class (Construct r ix e, Manifest r ix e) => Mutable r ix e where +class Manifest r e => Mutable r e where data MArray s r ix e :: * -- | Get the size of a mutable array. -- -- @since 0.1.0 - msize :: MArray s r ix e -> Sz ix + msize :: Index ix => MArray s r ix e -> Sz ix + + -- | Get the size of a mutable array. + -- + -- @since 0.1.0 + munsafeResize :: (Index ix', Index ix) => Sz ix' -> MArray s r ix e -> MArray s r ix' e -- | Convert immutable array into a mutable array without copy. -- -- @since 0.1.0 - unsafeThaw :: PrimMonad m => Array r ix e -> m (MArray (PrimState m) r ix e) + unsafeThaw :: (Index ix, PrimMonad m) => Array r ix e -> m (MArray (PrimState m) r ix e) -- | Convert mutable array into an immutable array without copy. -- -- @since 0.1.0 - unsafeFreeze :: PrimMonad m => Comp -> MArray (PrimState m) r ix e -> m (Array r ix e) + unsafeFreeze :: (Index ix, PrimMonad m) => Comp -> MArray (PrimState m) r ix e -> m (Array r ix e) -- | Create new mutable array, leaving it's elements uninitialized. Size isn't validated either. -- -- @since 0.1.0 - unsafeNew :: PrimMonad m => Sz ix -> m (MArray (PrimState m) r ix e) + unsafeNew :: (Index ix, PrimMonad m) => Sz ix -> m (MArray (PrimState m) r ix e) -- | Read an element at linear row-major index -- -- @since 0.1.0 - unsafeLinearRead :: PrimMonad m => MArray (PrimState m) r ix e -> Int -> m e + unsafeLinearRead :: (Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> Int -> m e -- | Write an element into mutable array with linear row-major index -- -- @since 0.1.0 - unsafeLinearWrite :: PrimMonad m => MArray (PrimState m) r ix e -> Int -> e -> m () + unsafeLinearWrite :: (Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> Int -> e -> m () -- | Initialize mutable array to some default value. -- -- @since 0.3.0 - initialize :: PrimMonad m => MArray (PrimState m) r ix e -> m () + initialize :: (Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> m () -- | Create new mutable array while initializing all elements to some default value. -- -- @since 0.3.0 - initializeNew :: PrimMonad m => Maybe e -> Sz ix -> m (MArray (PrimState m) r ix e) + initializeNew :: (Index ix, PrimMonad m) => Maybe e -> Sz ix -> m (MArray (PrimState m) r ix e) initializeNew Nothing sz = unsafeNew sz >>= \ma -> ma <$ initialize ma initializeNew (Just e) sz = newMArray sz e {-# INLINE initializeNew #-} @@ -476,7 +558,7 @@ class (Construct r ix e, Manifest r ix e) => Mutable r ix e where -- | Create new mutable array while initializing all elements to the specified value. -- -- @since 0.6.0 - newMArray :: PrimMonad m => Sz ix -> e -> m (MArray (PrimState m) r ix e) + newMArray :: (Index ix, PrimMonad m) => Sz ix -> e -> m (MArray (PrimState m) r ix e) newMArray sz e = do marr <- unsafeNew sz marr <$ unsafeLinearSet marr 0 (SafeSz (totalElem sz)) e @@ -485,7 +567,7 @@ class (Construct r ix e, Manifest r ix e) => Mutable r ix e where -- | Set all cells in the mutable array within the range to a specified value. -- -- @since 0.3.0 - unsafeLinearSet :: PrimMonad m => + unsafeLinearSet :: (Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> Ix1 -> Sz1 -> e -> m () unsafeLinearSet marr offset len e = loopM_ offset (< (offset + unSz len)) (+1) (\i -> unsafeLinearWrite marr i e) @@ -494,7 +576,7 @@ class (Construct r ix e, Manifest r ix e) => Mutable r ix e where -- | Copy part of one mutable array into another -- -- @since 0.3.6 - unsafeLinearCopy :: (Mutable r ix' e, PrimMonad m) => + unsafeLinearCopy :: (Index ix', Index ix, PrimMonad m) => MArray (PrimState m) r ix' e -- ^ Source mutable array -> Ix1 -- ^ Starting index at source array -> MArray (PrimState m) r ix e -- ^ Target mutable array @@ -510,7 +592,7 @@ class (Construct r ix e, Manifest r ix e) => Mutable r ix e where -- | Copy a part of a pure array into a mutable array -- -- @since 0.3.6 - unsafeArrayLinearCopy :: (Mutable r ix' e, PrimMonad m) => + unsafeArrayLinearCopy :: (Index ix', Index ix, PrimMonad m) => Array r ix' e -- ^ Source pure array -> Ix1 -- ^ Starting index at source array -> MArray (PrimState m) r ix e -- ^ Target mutable array @@ -528,7 +610,7 @@ class (Construct r ix e, Manifest r ix e) => Mutable r ix e where -- no longer be used. -- -- @since 0.3.6 - unsafeLinearShrink :: PrimMonad m => + unsafeLinearShrink :: (Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> Sz ix -> m (MArray (PrimState m) r ix e) unsafeLinearShrink = unsafeDefaultLinearShrink {-# INLINE unsafeLinearShrink #-} @@ -538,7 +620,7 @@ class (Construct r ix e, Manifest r ix e) => Mutable r ix e where -- should no longer be used. -- -- @since 0.3.6 - unsafeLinearGrow :: PrimMonad m => + unsafeLinearGrow :: (Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> Sz ix -> m (MArray (PrimState m) r ix e) unsafeLinearGrow marr sz = do marr' <- unsafeNew sz @@ -548,7 +630,7 @@ class (Construct r ix e, Manifest r ix e) => Mutable r ix e where unsafeDefaultLinearShrink :: - (Mutable r ix e, PrimMonad m) + (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> Sz ix -> m (MArray (PrimState m) r ix e) @@ -562,7 +644,7 @@ unsafeDefaultLinearShrink marr sz = do -- | Read an array element -- -- @since 0.1.0 -unsafeRead :: (Mutable r ix e, PrimMonad m) => +unsafeRead :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> m e unsafeRead marr = unsafeLinearRead marr . toLinearIndex (msize marr) {-# INLINE unsafeRead #-} @@ -570,7 +652,7 @@ unsafeRead marr = unsafeLinearRead marr . toLinearIndex (msize marr) -- | Write an element into array -- -- @since 0.1.0 -unsafeWrite :: (Mutable r ix e, PrimMonad m) => +unsafeWrite :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> e -> m () unsafeWrite marr = unsafeLinearWrite marr . toLinearIndex (msize marr) {-# INLINE unsafeWrite #-} @@ -579,7 +661,7 @@ unsafeWrite marr = unsafeLinearWrite marr . toLinearIndex (msize marr) -- | Modify an element in the array with a monadic action. Returns the previous value. -- -- @since 0.4.0 -unsafeLinearModify :: (Mutable r ix e, PrimMonad m) => +unsafeLinearModify :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (e -> m e) -> Int -> m e unsafeLinearModify !marr f !i = do v <- unsafeLinearRead marr i @@ -591,7 +673,7 @@ unsafeLinearModify !marr f !i = do -- | Modify an element in the array with a monadic action. Returns the previous value. -- -- @since 0.4.0 -unsafeModify :: (Mutable r ix e, PrimMonad m) => +unsafeModify :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (e -> m e) -> ix -> m e unsafeModify marr f ix = unsafeLinearModify marr f (toLinearIndex (msize marr) ix) {-# INLINE unsafeModify #-} @@ -600,8 +682,8 @@ unsafeModify marr f ix = unsafeLinearModify marr f (toLinearIndex (msize marr) i -- values. -- -- @since 0.4.0 -unsafeSwap :: (Mutable r ix e, PrimMonad m) => - MArray (PrimState m) r ix e -> ix -> ix -> m (e, e) +unsafeSwap :: (Mutable r e, Index ix, PrimMonad m) => + MArray (PrimState m) r ix e -> ix -> ix -> m (e, e) unsafeSwap !marr !ix1 !ix2 = unsafeLinearSwap marr (toLinearIndex sz ix1) (toLinearIndex sz ix2) where sz = msize marr {-# INLINE unsafeSwap #-} @@ -611,7 +693,7 @@ unsafeSwap !marr !ix1 !ix2 = unsafeLinearSwap marr (toLinearIndex sz ix1) (toLin -- previous values. -- -- @since 0.4.0 -unsafeLinearSwap :: (Mutable r ix e, PrimMonad m) => +unsafeLinearSwap :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> Int -> Int -> m (e, e) unsafeLinearSwap !marr !i1 !i2 = do val1 <- unsafeLinearRead marr i1 @@ -631,23 +713,17 @@ class Construct r ix e => Ragged r ix e where emptyR :: Comp -> Array r ix e - isNull :: Array r ix e -> Bool - consR :: Elt r ix e -> Array r ix e -> Array r ix e unconsR :: Array r ix e -> Maybe (Elt r ix e, Array r ix e) generateRaggedM :: Monad m => Comp -> Sz ix -> (ix -> m e) -> m (Array r ix e) - edgeSize :: Array r ix e -> Sz ix - flattenRagged :: Array r ix e -> Array r Ix1 e loadRagged :: Monad m => (m () -> m ()) -> (Int -> e -> m a) -> Int -> Int -> Sz ix -> Array r ix e -> m () - -- TODO: test property: - -- (read $ raggedFormat show "\n" (ls :: Array L (IxN n) Int)) == ls raggedFormat :: (e -> String) -> String -> Array r ix e -> String @@ -721,7 +797,7 @@ infixl 4 !, !?, ?? -- *** Exception: IndexOutOfBoundsException: (0 :. 3) is not safe for (Sz (2 :. 3)) -- -- @since 0.1.0 -(!) :: Manifest r ix e => Array r ix e -> ix -> e +(!) :: (Index ix, Manifest r e) => Array r ix e -> ix -> e (!) = index' {-# INLINE (!) #-} @@ -748,7 +824,7 @@ infixl 4 !, !?, ?? -- Nothing -- -- @since 0.1.0 -(!?) :: (Manifest r ix e, MonadThrow m) => Array r ix e -> ix -> m e +(!?) :: (Index ix, Manifest r e, MonadThrow m) => Array r ix e -> ix -> m e (!?) = indexM {-# INLINE (!?) #-} @@ -783,7 +859,7 @@ infixl 4 !, !?, ?? -- Just 6 -- -- @since 0.1.0 -(??) :: (Manifest r ix e, MonadThrow m) => m (Array r ix e) -> ix -> m e +(??) :: (Index ix, Manifest r e, MonadThrow m) => m (Array r ix e) -> ix -> m e (??) marr ix = marr >>= (!? ix) {-# INLINE (??) #-} @@ -792,7 +868,7 @@ infixl 4 !, !?, ?? -- general and it can just as well be used with `Maybe`. -- -- @since 0.1.0 -index :: Manifest r ix e => Array r ix e -> ix -> Maybe e +index :: (Index ix, Manifest r e) => Array r ix e -> ix -> Maybe e index = indexM {-# INLINE index #-} @@ -801,7 +877,7 @@ index = indexM -- /__Exceptions__/: `IndexOutOfBoundsException` -- -- @since 0.3.0 -indexM :: (Manifest r ix e, MonadThrow m) => Array r ix e -> ix -> m e +indexM :: (Index ix, Manifest r e, MonadThrow m) => Array r ix e -> ix -> m e indexM = evaluateM {-# INLINE indexM #-} @@ -819,7 +895,7 @@ indexM = evaluateM -- 999 -- -- @since 0.1.0 -defaultIndex :: Manifest r ix e => e -> Array r ix e -> ix -> e +defaultIndex :: (Index ix, Manifest r e) => e -> Array r ix e -> ix -> e defaultIndex defVal = borderIndex (Fill defVal) {-# INLINE defaultIndex #-} @@ -836,7 +912,7 @@ defaultIndex defVal = borderIndex (Fill defVal) -- [ 99, 100, 0, 1, 2 ] -- -- @since 0.1.0 -borderIndex :: Manifest r ix e => Border e -> Array r ix e -> ix -> e +borderIndex :: (Index ix, Manifest r e) => Border e -> Array r ix e -> ix -> e borderIndex border arr = handleBorderIndex border (size arr) (unsafeIndex arr) {-# INLINE borderIndex #-} @@ -854,7 +930,7 @@ borderIndex border arr = handleBorderIndex border (size arr) (unsafeIndex arr) -- *** Exception: IndexOutOfBoundsException: 150 is not safe for (Sz1 101) -- -- @since 0.1.0 -index' :: Manifest r ix e => Array r ix e -> ix -> e +index' :: (Index ix, Manifest r e) => Array r ix e -> ix -> e index' = evaluate' {-# INLINE index' #-} @@ -873,7 +949,7 @@ index' = evaluate' -- Left (IndexOutOfBoundsException: (150 :. 150) is not safe for (Sz (90 :. 190))) -- -- @since 0.3.0 -evaluateM :: (Source r ix e, MonadThrow m) => Array r ix e -> ix -> m e +evaluateM :: (Index ix, Source r e, MonadThrow m) => Array r ix e -> ix -> m e evaluateM arr ix = handleBorderIndex (Fill (throwM (IndexOutOfBoundsException (size arr) ix))) @@ -893,7 +969,7 @@ evaluateM arr ix = -- *** Exception: IndexOutOfBoundsException: (150 :. 150) is not safe for (Sz (90 :. 190)) -- -- @since 0.3.0 -evaluate' :: Source r ix e => Array r ix e -> ix -> e +evaluate' :: (Index ix, Source r e) => Array r ix e -> ix -> e evaluate' arr ix = handleBorderIndex (Fill (throw (IndexOutOfBoundsException (size arr) ix))) @@ -916,35 +992,28 @@ evaluate' arr ix = -- (4,14) -- -- @since 0.1.0 -imapM_ :: (Source r ix a, Monad m) => (ix -> a -> m b) -> Array r ix a -> m () +imapM_ :: (Index ix, Source r a, Monad m) => (ix -> a -> m b) -> Array r ix a -> m () imapM_ f !arr = iterM_ zeroIndex (unSz (size arr)) (pureIndex 1) (<) $ \ !ix -> f ix (unsafeIndex arr ix) {-# INLINE imapM_ #-} --- | /O(1)/ - Get the number of elements in the array. --- --- /Note/ - It is always a constant time operation except for some arrays with --- `Data.Massiv.Array.DS` representation. See `Data.Massiv.Vector.slength` for more info. + +-- | /O(1)/ - Check if array has elements. -- -- ==== __Examples__ -- -- >>> import Data.Massiv.Array --- >>> elemsCount $ range Seq (Ix1 10) 15 --- 5 +-- >>> isNotEmpty (singleton 1 :: Array D Ix2 Int) +-- True +-- >>> isNotEmpty (empty :: Array D Ix2 Int) +-- False -- --- @since 0.1.0 -elemsCount :: Load r ix e => Array r ix e -> Int -elemsCount = totalElem . size -{-# INLINE elemsCount #-} - +-- @since 0.5.1 +isNotEmpty :: Shape r ix => Array r ix e -> Bool +isNotEmpty = not . isEmpty +{-# INLINE isNotEmpty #-} --- | Get the number of elements in the array --- --- @since 0.5.8 -linearSize :: Load r ix e => Array r ix e -> Sz1 -linearSize = toLinearSz . size -{-# INLINE linearSize #-} -- | /O(1)/ - Check if array has elements. @@ -958,6 +1027,36 @@ linearSize = toLinearSz . size -- False -- -- @since 0.5.1 -isNotEmpty :: Load r ix e => Array r ix e -> Bool -isNotEmpty = not . isEmpty -{-# INLINE isNotEmpty #-} +isNull :: (Index ix, Size r) => Array r ix e -> Bool +isNull = (==0) . elemsCount +{-# INLINE isNull #-} + + +-- | /O(1)/ - Get the number of elements in the array. +-- +-- /Note/ - It is always a constant time operation except for some arrays with +-- `Data.Massiv.Array.DS` representation. See `Data.Massiv.Vector.slength` for more info. +-- +-- ==== __Examples__ +-- +-- >>> import Data.Massiv.Array +-- >>> elemsCount $ range Seq (Ix1 10) 15 +-- 5 +-- +-- @since 0.1.0 +elemsCount :: (Index ix, Size r) => Array r ix e -> Int +elemsCount = totalElem . size +{-# INLINE elemsCount #-} + + +inline0 :: (a -> b) -> a -> b +inline0 f = f +{-# INLINE [0] inline0 #-} + +inline1 :: (a -> b) -> a -> b +inline1 f = f +{-# INLINE [1] inline1 #-} + +inline2 :: (a -> b) -> a -> b +inline2 f = f +{-# INLINE [2] inline2 #-} diff --git a/massiv/src/Data/Massiv/Core/List.hs b/massiv/src/Data/Massiv/Core/List.hs index b9fd07d1..bf3e32a9 100644 --- a/massiv/src/Data/Massiv/Core/List.hs +++ b/massiv/src/Data/Massiv/Core/List.hs @@ -1,11 +1,14 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | @@ -30,12 +33,14 @@ import Control.Exception import Control.Monad (unless, when) import Control.Scheduler import Data.Coerce +import Data.Monoid import Data.Foldable (foldr') import qualified Data.List as L import qualified Data.Massiv.Vector.Stream as S import Data.Massiv.Core.Common import Data.Typeable import GHC.Exts +import GHC.TypeLits import System.IO.Unsafe (unsafePerformIO) data LN @@ -48,10 +53,12 @@ type instance NestedStruct LN ix e = [ListItem ix e] newtype instance Array LN ix e = List { unList :: [Elt LN ix e] } +--TODO remove +instance Strategy LN where + getComp _ = Seq + setComp _ = id instance Construct LN Ix1 e where - setComp _ = id - {-# INLINE setComp #-} makeArray _ (Sz n) f = coerce (L.map f [0 .. n - 1]) {-# INLINE makeArray #-} makeArrayLinear _ (Sz n) f = coerce (L.map f [0 .. n - 1]) @@ -87,7 +94,8 @@ data L = L type instance NestedStruct L ix e = Array LN ix e data instance Array L ix e = LArray { lComp :: Comp - , lData :: !(Array LN ix e) } + , lData :: !(Array LN ix e) + } instance Nested L ix e where @@ -104,13 +112,102 @@ instance Nested LN ix e => IsList (Array L ix e) where toList = toNested . lData {-# INLINE toList #-} -instance {-# OVERLAPPING #-} Ragged L Ix1 e where - isNull = null . unList . lData - {-# INLINE isNull #-} +lengthHintList :: [a] -> LengthHint +lengthHintList = + \case + [] -> LengthExact zeroSz + _ -> LengthUnknown +{-# INLINE lengthHintList #-} + + +instance Shape LN Ix1 where + linearSize = SafeSz . length . unList + {-# INLINE linearSize #-} + linearSizeHint = lengthHintList . unList + {-# INLINE linearSizeHint #-} + isEmpty = null . unList + {-# INLINE isEmpty #-} + outerSize = linearSize + {-# INLINE outerSize #-} + +instance Shape L Ix1 where + linearSize = linearSize . lData + {-# INLINE linearSize #-} + linearSizeHint = linearSizeHint . lData + {-# INLINE linearSizeHint #-} + isEmpty = isEmpty . lData + {-# INLINE isEmpty #-} + outerSize = linearSize + {-# INLINE outerSize #-} + +instance Shape LN Ix2 where + linearSize = SafeSz . getSum . foldMap (Sum . length . unList) . unList + {-# INLINE linearSize #-} + linearSizeHint = lengthHintList . unList + {-# INLINE linearSizeHint #-} + isEmpty = null . unList + {-# INLINE isEmpty #-} + outerSize arr = + case unList arr of + [] -> zeroSz + (x:xs) -> SafeSz ((1 + length xs) :. length (unList x)) + {-# INLINE outerSize #-} + +instance Shape L Ix2 where + linearSize = linearSize . lData + {-# INLINE linearSize #-} + linearSizeHint = linearSizeHint . lData + {-# INLINE linearSizeHint #-} + isEmpty = isEmpty . lData + {-# INLINE isEmpty #-} + outerSize = outerSize . lData + {-# INLINE outerSize #-} + +-- instance Shape LN Ix3 where +-- linearSize = SafeSz . getSum . foldMap (Sum . unSz . linearSize) . unList +-- {-# INLINE linearSize #-} +-- linearSizeHint = lengthHintList . unList +-- {-# INLINE linearSizeHint #-} +-- isEmpty = null . unList +-- {-# INLINE isEmpty #-} +-- outerSize arr = +-- case unList arr of +-- [] -> zeroSz +-- (x:xs) -> SafeSz ((1 + length xs) :> unSz (outerSize x)) +-- {-# INLINE outerSize #-} + +instance (Shape LN (Ix (n - 1)), Index (IxN n)) => Shape LN (IxN n) where + linearSize = SafeSz . getSum . foldMap (Sum . unSz . linearSize) . unList + {-# INLINE linearSize #-} + linearSizeHint = lengthHintList . unList + {-# INLINE linearSizeHint #-} + isEmpty = null . unList + {-# INLINE isEmpty #-} + outerSize arr = + case unList arr of + [] -> zeroSz + (x:xs) -> SafeSz ((1 + length xs) :> unSz (outerSize x)) + {-# INLINE outerSize #-} + + +instance (Index (IxN n), Shape LN (IxN n)) => Shape L (IxN n) where + linearSize = linearSize . lData + {-# INLINE linearSize #-} + linearSizeHint = linearSizeHint . lData + {-# INLINE linearSizeHint #-} + isEmpty = isEmpty . lData + {-# INLINE isEmpty #-} + outerSize = outerSize . lData + {-# INLINE outerSize #-} + + +outerLength :: Array L ix e -> Sz Int +outerLength = SafeSz . length . unList . lData + + +instance Ragged L Ix1 e where emptyR comp = LArray comp (List []) {-# INLINE emptyR #-} - edgeSize = SafeSz . length . unList . lData - {-# INLINE edgeSize #-} consR x arr = arr { lData = coerce (x : coerce (lData arr)) } {-# INLINE consR #-} unconsR LArray {..} = @@ -133,58 +230,78 @@ instance {-# OVERLAPPING #-} Ragged L Ix1 e where case unconsR xs' of Nothing -> return $! throw (DimTooShortException sz (outerLength xs)) Just (y, ys) -> uWrite i y >> return ys - unless (isNull leftOver) (return $! throw DimTooLongException) + unless (isEmpty leftOver) (return $! throw DimTooLongException) {-# INLINE loadRagged #-} raggedFormat f _ arr = L.concat $ "[ " : L.intersperse ", " (map f (coerce (lData arr))) ++ [" ]"] -instance (Index ix, Ragged L ix e) => Load L ix e where - size = coerce . edgeSize - {-# INLINE size #-} - getComp = lComp - {-# INLINE getComp #-} +instance (Shape L ix, Ragged L ix e) => Load L ix e where loadArrayM scheduler arr uWrite = loadRagged (scheduleWork scheduler) uWrite 0 (totalElem sz) sz arr - where !sz = edgeSize arr + where !sz = outerSize arr {-# INLINE loadArrayM #-} -instance (Index ix, Load L ix e, Ragged L ix e) => Load LN ix e where - size = edgeSize . LArray Seq - {-# INLINE size #-} - getComp _ = Seq - {-# INLINE getComp #-} +instance (Shape LN ix, Ragged L ix e) => Load LN ix e where loadArrayM scheduler arr uWrite = loadRagged (scheduleWork scheduler) uWrite 0 (totalElem sz) sz arrL where !arrL = LArray Seq arr - !sz = size arrL + !sz = outerSize arrL {-# INLINE loadArrayM #-} +instance Ragged L Ix2 e where + emptyR comp = LArray comp (List []) + {-# INLINE emptyR #-} + consR (LArray _ x) arr = newArr + where + newArr = arr {lData = coerce (x : coerce (lData arr))} + {-# INLINE consR #-} + unconsR LArray {..} = + case L.uncons (coerce lData) of + Nothing -> Nothing + Just (x, xs) -> + let newArr = LArray lComp (coerce xs) + newX = LArray lComp x + in Just (newX, newArr) + {-# INLINE unconsR #-} + generateRaggedM = unsafeGenerateParM + {-# INLINE generateRaggedM #-} + flattenRagged arr = LArray {lComp = lComp arr, lData = coerce xs} + where + xs = concatMap (unList . lData . flattenRagged . LArray (lComp arr)) (unList (lData arr)) + {-# INLINE flattenRagged #-} + loadRagged using uWrite start end sz xs = do + let (k, szL) = unconsSz sz + step = totalElem szL + isZero = totalElem sz == 0 + when (isZero && not (isEmpty (flattenRagged xs))) (return $! throw DimTooLongException) + unless isZero $ do + leftOver <- + loopM start (< end) (+ step) xs $ \i zs -> + case unconsR zs of + Nothing -> return $! throw (DimTooShortException k (outerLength xs)) + Just (y, ys) -> do + _ <- loadRagged using uWrite i (i + step) szL y + return ys + unless (isEmpty leftOver) (return $! throw DimTooLongException) + {-# INLINE loadRagged #-} + raggedFormat f sep (LArray comp xs) = + showN (\s y -> raggedFormat f s (LArray comp y :: Array L Ix1 e)) sep (coerce xs) -outerLength :: Array L ix e -> Sz Int -outerLength = SafeSz . length . unList . lData -instance ( Index ix - , Index (Lower ix) - , Ragged L (Lower ix) e - , Elt L ix e ~ Array L (Lower ix) e - , Elt LN ix e ~ Array LN (Lower ix) e - , Coercible (Elt LN ix e) [Elt LN (Lower ix) e] +-- Ragged L (Lower ix) e +-- , Elt L ix e ~ Array L (Lower ix) e +-- , Elt LN ix e ~ Array LN (Lower ix) e +-- , +instance ( Shape L (IxN n) + , Shape LN (Ix (n - 1)) + , Ragged L (Ix (n - 1)) e ) => - Ragged L ix e where - isNull = null . unList . lData - {-# INLINE isNull #-} + Ragged L (IxN n) e where emptyR comp = LArray comp (List []) {-# INLINE emptyR #-} - edgeSize arr = - SafeSz - (consDim (length (unList (lData arr))) $ - case unconsR arr of - Nothing -> zeroIndex - Just (x, _) -> coerce (edgeSize x)) - {-# INLINE edgeSize #-} consR (LArray _ x) arr = newArr where newArr = arr {lData = coerce (x : coerce (lData arr))} @@ -197,11 +314,6 @@ instance ( Index ix newX = LArray lComp x in Just (newX, newArr) {-# INLINE unconsR #-} - -- generateRaggedM Seq !sz f = do - -- let !(k, szL) = unconsSz sz - -- loopDeepM 0 (< coerce k) (+ 1) (emptyR Seq) $ \i acc -> do - -- e <- generateRaggedM Seq szL (\ !ixL -> f (consDim i ixL)) - -- return (cons e acc) generateRaggedM = unsafeGenerateParM {-# INLINE generateRaggedM #-} flattenRagged arr = LArray {lComp = lComp arr, lData = coerce xs} @@ -212,7 +324,7 @@ instance ( Index ix let (k, szL) = unconsSz sz step = totalElem szL isZero = totalElem sz == 0 - when (isZero && not (isNull (flattenRagged xs))) (return $! throw DimTooLongException) + when (isZero && not (isEmpty (flattenRagged xs))) (return $! throw DimTooLongException) unless isZero $ do leftOver <- loopM start (< end) (+ step) xs $ \i zs -> @@ -221,10 +333,10 @@ instance ( Index ix Just (y, ys) -> do _ <- loadRagged using uWrite i (i + step) szL y return ys - unless (isNull leftOver) (return $! throw DimTooLongException) + unless (isEmpty leftOver) (return $! throw DimTooLongException) {-# INLINE loadRagged #-} raggedFormat f sep (LArray comp xs) = - showN (\s y -> raggedFormat f s (LArray comp y :: Array L (Lower ix) e)) sep (coerce xs) + showN (\s y -> raggedFormat f s (LArray comp y :: Array L (Ix (n - 1)) e)) sep (coerce xs) unsafeGenerateParM :: (Elt LN ix e ~ Array LN (Lower ix) e, Index ix, Monad m, Ragged L (Lower ix) e) @@ -251,28 +363,28 @@ unsafeGenerateParM comp !sz f = do return $ LArray comp $ List $ concat res {-# INLINE unsafeGenerateParM #-} - -instance {-# OVERLAPPING #-} Construct L Ix1 e where - setComp c arr = arr { lComp = c } +instance Strategy L where + setComp c arr = arr {lComp = c} {-# INLINE setComp #-} + getComp = lComp + {-# INLINE getComp #-} + +instance Construct L Ix1 e where makeArray comp sz f = LArray comp $ List $ unsafePerformIO $ withScheduler comp $ \scheduler -> loopM_ 0 (< coerce sz) (+ 1) (scheduleWork scheduler . return . f) {-# INLINE makeArray #-} +instance Construct L Ix2 e where + makeArray = unsafeGenerateN + {-# INLINE makeArray #-} -instance ( Index ix - , Ragged L ix e - , Ragged L (Lower ix) e - , Elt L ix e ~ Array L (Lower ix) e - ) => - Construct L ix e where - setComp c arr = arr {lComp = c} - {-# INLINE setComp #-} +instance (Ragged L (Ix (n - 1)) e, Shape LN (Ix (n - 1)), Index (IxN n)) => + Construct L (IxN n) e where makeArray = unsafeGenerateN {-# INLINE makeArray #-} - -- TODO: benchmark against using unsafeGenerateM directly +-- TODO: benchmark against using unsafeGenerateM directly unsafeGenerateN :: ( Ragged r ix e , Ragged r (Lower ix) e @@ -293,7 +405,7 @@ unsafeGenerateN comp sz f = unsafePerformIO $ do -- | Construct an array backed by linked lists from any source array -- -- @since 0.4.0 -toListArray :: (Construct L ix e, Source r ix e) +toListArray :: (Construct L ix e, Load r ix e, Source r e) => Array r ix e -> Array L ix e toListArray !arr = makeArray (getComp arr) (size arr) (unsafeIndex arr) @@ -328,7 +440,7 @@ showsArrayLAsPrec pr n arr = ("Array " ++) . showsTypeRep (typeRep pr) . (' ':) . - showsPrec 1 (getComp arr) . (" (" ++) . shows (size arr) . (")\n" ++) . shows lnarr . clp + showsPrec 1 (getComp arr) . (" (" ++) . shows (outerSize arr) . (")\n" ++) . shows lnarr . clp where (opp, clp) = if n == 0 @@ -340,15 +452,15 @@ showsArrayLAsPrec pr n arr = -- -- @since 0.4.0 showsArrayPrec :: - forall r r' ix ix' e. (Ragged L ix' e, Load r ix e, Source r' ix' e, Show e) - => (Array r ix e -> Array r' ix' e) -- ^ Modifier + forall r r' ix e. (Ragged L ix e, Load r ix e, Load r' ix e, Source r' e, Show e) + => (Array r ix e -> Array r' ix e) -- ^ Modifier -> Int -> Array r ix e -- Array to show -> ShowS showsArrayPrec f n arr = showsArrayLAsPrec (Proxy :: Proxy r) n larr where arr' = f arr - larr = makeArray (getComp arr') (size arr') (evaluate' arr') :: Array L ix' e + larr = makeArray (getComp arr') (size arr') (evaluate' arr') :: Array L ix e -- | Helper function for declaring `Show` instances for arrays @@ -363,22 +475,6 @@ showArrayList arrs = ('[':) . go arrs . (']':) go (x:xs) = (' ':) . shows x . ("\n," ++) . go xs -instance {-# OVERLAPPING #-} OuterSlice L Ix1 e where - unsafeOuterSlice (LArray _ xs) = (coerce xs !!) - {-# INLINE unsafeOuterSlice #-} - - -instance Ragged L ix e => OuterSlice L ix e where - unsafeOuterSlice arr' i = go 0 arr' - where - go n arr = - case unconsR arr of - Nothing -> throw $ IndexOutOfBoundsException (Sz (headDim (unSz (size arr')))) i - Just (x, _) | n == i -> x - Just (_, xs) -> go (n + 1) xs - {-# INLINE unsafeOuterSlice #-} - - instance Stream LN Ix1 e where toStream = S.fromList . coerce {-# INLINE toStream #-} diff --git a/massiv/src/Data/Massiv/Core/Operations.hs b/massiv/src/Data/Massiv/Core/Operations.hs index 2075d702..6013a226 100644 --- a/massiv/src/Data/Massiv/Core/Operations.hs +++ b/massiv/src/Data/Massiv/Core/Operations.hs @@ -24,7 +24,10 @@ module Data.Massiv.Core.Operations import Data.Massiv.Core.Common -class Num e => FoldNumeric r e where + +class (Size r, Num e) => FoldNumeric r e where + + {-# MINIMAL foldArray, powerSumArray, unsafeDotProduct #-} -- | Compute sum of all elements in the array -- @@ -57,7 +60,7 @@ class Num e => FoldNumeric r e where defaultUnsafeDotProduct :: - (Num e, Source r ix e) => Array r ix e -> Array r ix e -> e + (Num e, Index ix, Source r e) => Array r ix e -> Array r ix e -> e defaultUnsafeDotProduct a1 a2 = go 0 0 where !len = totalElem (size a1) @@ -66,7 +69,7 @@ defaultUnsafeDotProduct a1 a2 = go 0 0 | otherwise = acc {-# INLINE defaultUnsafeDotProduct #-} -defaultPowerSumArray :: (Source r ix e, Num e) => Array r ix e -> Int -> e +defaultPowerSumArray :: (Index ix, Source r e, Num e) => Array r ix e -> Int -> e defaultPowerSumArray arr p = go 0 0 where !len = totalElem (size arr) @@ -75,7 +78,7 @@ defaultPowerSumArray arr p = go 0 0 | otherwise = acc {-# INLINE defaultPowerSumArray #-} -defaultFoldArray :: Source r ix e => (e -> e -> e) -> e -> Array r ix e -> e +defaultFoldArray :: (Index ix, Source r e) => (e -> e -> e) -> e -> Array r ix e -> e defaultFoldArray f !initAcc arr = go initAcc 0 where !len = totalElem (size arr) @@ -134,13 +137,13 @@ class FoldNumeric r e => Numeric r e where defaultUnsafeLiftArray :: - (Construct r ix e, Source r ix e) => (e -> e) -> Array r ix e -> Array r ix e + (Construct r ix e, Source r e) => (e -> e) -> Array r ix e -> Array r ix e defaultUnsafeLiftArray f arr = makeArrayLinear (getComp arr) (size arr) (f . unsafeLinearIndex arr) {-# INLINE defaultUnsafeLiftArray #-} defaultUnsafeLiftArray2 :: - (Construct r ix e, Source r ix e) + (Construct r ix e, Source r e) => (e -> e -> e) -> Array r ix e -> Array r ix e diff --git a/massiv/src/Data/Massiv/Vector.hs b/massiv/src/Data/Massiv/Vector.hs index f7314174..5a3c3cde 100644 --- a/massiv/src/Data/Massiv/Vector.hs +++ b/massiv/src/Data/Massiv/Vector.hs @@ -15,7 +15,7 @@ module Data.Massiv.Vector -- * Accessors -- *** Size , slength - , maxSize + , maxLinearSize , size , snull -- *** Indexing @@ -273,21 +273,6 @@ module Data.Massiv.Vector -- , unsafeFreeze -- , unsafeThaw -- , unsafeCopy - -- * Deprecated - , takeS - , dropS - , unfoldr - , unfoldrN - , filterS - , ifilterS - , filterM - , ifilterM - , mapMaybeS - , imapMaybeS - , mapMaybeM - , imapMaybeM - , catMaybesS - , traverseS -- ** Re-exports , module Data.Massiv.Core , module Data.Massiv.Array.Delayed @@ -306,13 +291,14 @@ import Data.Massiv.Array.Manifest.Internal import Data.Massiv.Array.Manifest.List (fromList) import Data.Massiv.Array.Mutable import Data.Massiv.Array.Ops.Construct -import qualified Data.Massiv.Array.Ops.Construct as A (makeArrayR, replicate) +import qualified Data.Massiv.Array.Ops.Construct as A (replicate) import Data.Massiv.Core import Data.Massiv.Core.Common import qualified Data.Massiv.Vector.Stream as S import Data.Massiv.Vector.Unsafe import Data.Maybe -import Prelude hiding (drop, init, length, null, replicate, splitAt, tail, take, takeWhile, dropWhile) +import Prelude hiding (drop, dropWhile, init, length, null, replicate, splitAt, + tail, take, takeWhile) -- ========= -- -- Accessors -- @@ -358,8 +344,8 @@ import Prelude hiding (drop, init, length, null, replicate, splitAt, tail, take, slength :: Stream r ix e => Array r ix e -> Maybe Sz1 slength v = case stepsSize (toStream v) of - Exact sz -> Just (SafeSz sz) - _ -> Nothing + LengthExact sz -> Just sz + _ -> Nothing {-# INLINE slength #-} -- | /O(1)/ - Check whether a `Stream` array is empty or not. It only looks at the exact size @@ -420,7 +406,7 @@ snull = isEmpty -- cause materialization of the full vector if any other function is applied to the vector. -- -- @since 0.5.0 -head' :: Source r Ix1 e => Vector r e -> e +head' :: Source r e => Vector r e -> e head' = either throw id . headM {-# INLINE head' #-} @@ -448,9 +434,9 @@ head' = either throw id . headM -- except it is restricted to `Maybe` -- -- @since 0.5.0 -headM :: (Source r Ix1 e, MonadThrow m) => Vector r e -> m e +headM :: (Source r e, MonadThrow m) => Vector r e -> m e headM v - | isEmpty v = throwM $ SizeEmptyException (size v) + | elemsCount v == 0 = throwM $ SizeEmptyException (size v) | otherwise = pure $ unsafeLinearIndex v 0 {-# INLINE headM #-} @@ -493,7 +479,7 @@ shead' = either throw id . sheadM sheadM :: (Stream r Ix1 e, MonadThrow m) => Vector r e -> m e sheadM v = case S.unId (S.headMaybe (toStream v)) of - Nothing -> throwM $ SizeEmptyException (size v) + Nothing -> throwM $ SizeEmptyException (zeroSz :: Sz1) Just e -> pure e {-# INLINE sheadM #-} @@ -517,7 +503,7 @@ sheadM v = -- the more general `MonadThrow` -- -- @since 0.3.0 -unconsM :: (MonadThrow m, Source r Ix1 e) => Vector r e -> m (e, Vector r e) +unconsM :: (MonadThrow m, Source r e) => Vector r e -> m (e, Vector r e) unconsM arr | 0 == totalElem sz = throwM $ SizeEmptyException sz | otherwise = pure (unsafeLinearIndex arr 0, unsafeLinearSlice 1 (SafeSz (unSz sz - 1)) arr) @@ -539,7 +525,7 @@ unconsM arr -- [ 1, 2 ],3) -- -- @since 0.3.0 -unsnocM :: (MonadThrow m, Source r Ix1 e) => Vector r e -> m (Vector r e, e) +unsnocM :: (MonadThrow m, Source r e) => Vector r e -> m (Vector r e, e) unsnocM arr | 0 == totalElem sz = throwM $ SizeEmptyException sz | otherwise = pure (unsafeLinearSlice 0 (SafeSz k) arr, unsafeLinearIndex arr k) @@ -569,7 +555,7 @@ unsnocM arr -- cause materialization of the full vector if any other function is applied to the vector. -- -- @since 0.5.0 -last' :: Source r Ix1 e => Vector r e -> e +last' :: Source r e => Vector r e -> e last' = either throw id . lastM {-# INLINE last' #-} @@ -590,7 +576,7 @@ last' = either throw id . lastM -- "SizeEmptyException: (Sz1 0) corresponds to an empty array" -- -- @since 0.5.0 -lastM :: (Source r Ix1 e, MonadThrow m) => Vector r e -> m e +lastM :: (Source r e, MonadThrow m) => Vector r e -> m e lastM v | k == 0 = throwM $ SizeEmptyException (size v) | otherwise = pure $ unsafeLinearIndex v (k - 1) @@ -613,7 +599,7 @@ lastM v -- [ 9999999999998, 9999999999999, 10000000000000 ] -- -- @since 0.5.0 -slice :: Source r Ix1 e => Ix1 -> Sz1 -> Vector r e -> Vector r e +slice :: Source r e => Ix1 -> Sz1 -> Vector r e -> Vector r e slice !i (Sz k) v = unsafeLinearSlice i' newSz v where !i' = min n (max 0 i) @@ -639,7 +625,7 @@ slice !i (Sz k) v = unsafeLinearSlice i' newSz v -- [ 9999999999998, 9999999999999, 10000000000000 ] -- -- @since 0.5.0 -slice' :: Source r Ix1 e => Ix1 -> Sz1 -> Vector r e -> Vector r e +slice' :: Source r e => Ix1 -> Sz1 -> Vector r e -> Vector r e slice' i k = either throw id . sliceM i k {-# INLINE slice' #-} @@ -652,7 +638,7 @@ slice' i k = either throw id . sliceM i k -- -- -- @since 0.5.0 -sliceM :: (Source r Ix1 e, MonadThrow m) => Ix1 -> Sz1 -> Vector r e -> m (Vector r e) +sliceM :: (Source r e, MonadThrow m) => Ix1 -> Sz1 -> Vector r e -> m (Vector r e) sliceM i newSz@(Sz k) v | i >= 0 && k <= n - i = pure $ unsafeLinearSlice i newSz v | otherwise = throwM $ SizeSubregionException sz i newSz @@ -686,7 +672,7 @@ sliceM i newSz@(Sz k) v -- -- @since 0.5.0 sslice :: Stream r Ix1 e => Ix1 -> Sz1 -> Vector r e -> Vector DS e -sslice !i (Sz k) = fromSteps . S.slice i k . S.toStream +sslice !i !k = fromSteps . S.slice i k . S.toStream {-# INLINE sslice #-} @@ -702,7 +688,7 @@ sslice !i (Sz k) = fromSteps . S.slice i k . S.toStream -- [ ] -- -- @since 0.5.0 -init :: Source r Ix1 e => Vector r e -> Vector r e +init :: Source r e => Vector r e -> Vector r e init v = unsafeLinearSlice 0 (Sz (coerce (size v) - 1)) v {-# INLINE init #-} @@ -717,7 +703,7 @@ init v = unsafeLinearSlice 0 (Sz (coerce (size v) - 1)) v -- Array D *** Exception: SizeEmptyException: (Sz1 0) corresponds to an empty array -- -- @since 0.5.0 -init' :: Source r Ix1 e => Vector r e -> Vector r e +init' :: Source r e => Vector r e -> Vector r e init' = either throw id . initM {-# INLINE init' #-} @@ -734,9 +720,9 @@ init' = either throw id . initM -- 0 -- -- @since 0.5.0 -initM :: (Source r Ix1 e, MonadThrow m) => Vector r e -> m (Vector r e) +initM :: (Source r e, MonadThrow m) => Vector r e -> m (Vector r e) initM v = do - when (isEmpty v) $ throwM $ SizeEmptyException $ size v + when (elemsCount v == 0) $ throwM $ SizeEmptyException $ size v pure $ unsafeInit v {-# INLINE initM #-} @@ -754,7 +740,7 @@ initM v = do -- [ ] -- -- @since 0.5.0 -tail :: Source r Ix1 e => Vector r e -> Vector r e +tail :: Source r e => Vector r e -> Vector r e tail = drop 1 {-# INLINE tail #-} @@ -770,7 +756,7 @@ tail = drop 1 -- Array D *** Exception: SizeEmptyException: (Sz1 0) corresponds to an empty array -- -- @since 0.5.0 -tail' :: Source r Ix1 e => Vector r e -> Vector r e +tail' :: Source r e => Vector r e -> Vector r e tail' = either throw id . tailM {-# INLINE tail' #-} @@ -788,9 +774,9 @@ tail' = either throw id . tailM -- 0 -- -- @since 0.5.0 -tailM :: (Source r Ix1 e, MonadThrow m) => Vector r e -> m (Vector r e) +tailM :: (Source r e, MonadThrow m) => Vector r e -> m (Vector r e) tailM v = do - when (isEmpty v) $ throwM $ SizeEmptyException $ size v + when (elemsCount v == 0) $ throwM $ SizeEmptyException $ size v pure $ unsafeTail v {-# INLINE tailM #-} @@ -812,7 +798,7 @@ tailM v = do -- >>> -- -- @since 0.5.0 -take :: Source r Ix1 e => Sz1 -> Vector r e -> Vector r e +take :: Source r e => Sz1 -> Vector r e -> Vector r e take k = fst . sliceAt k {-# INLINE take #-} @@ -821,7 +807,7 @@ take k = fst . sliceAt k -- satisfy the supplied predicate. -- -- @since 0.5.5 -takeWhile :: Manifest r Ix1 e => (e -> Bool) -> Vector r e -> Vector r e +takeWhile :: Manifest r e => (e -> Bool) -> Vector r e -> Vector r e takeWhile f v = take (go 0) v where !k = elemsCount v @@ -848,7 +834,7 @@ takeWhile f v = take (go 0) v -- Array D *** Exception: SizeSubregionException: (Sz1 10) is to small for 0 (Sz1 15) -- -- @since 0.5.0 -take' :: Source r Ix1 e => Sz1 -> Vector r e -> Vector r e +take' :: Source r e => Sz1 -> Vector r e -> Vector r e take' k = either throw id . takeM k {-# INLINE take' #-} @@ -865,7 +851,7 @@ take' k = either throw id . takeM k -- -1 -- -- @since 0.5.0 -takeM :: (Source r Ix1 e, MonadThrow m) => Sz1 -> Vector r e -> m (Vector r e) +takeM :: (Source r e, MonadThrow m) => Sz1 -> Vector r e -> m (Vector r e) takeM k v = do let sz = size v when (k > sz) $ throwM $ SizeSubregionException sz 0 k @@ -878,7 +864,7 @@ takeM k v = do -- -- @since 0.5.0 stake :: Stream r Ix1 e => Sz1 -> Vector r e -> Vector DS e -stake n = fromSteps . S.take (unSz n) . S.toStream +stake n = fromSteps . S.take n . S.toStream {-# INLINE stake #-} -- | @@ -886,7 +872,7 @@ stake n = fromSteps . S.take (unSz n) . S.toStream -- ==== __Examples__ -- -- @since 0.5.0 -drop :: Source r Ix1 e => Sz1 -> Vector r e -> Vector r e +drop :: Source r e => Sz1 -> Vector r e -> Vector r e drop k = snd . sliceAt k {-# INLINE drop #-} @@ -895,7 +881,7 @@ drop k = snd . sliceAt k -- that satisfy the supplied predicate. -- -- @since 0.5.5 -dropWhile :: Manifest r Ix1 e => (e -> Bool) -> Vector r e -> Vector r e +dropWhile :: Manifest r e => (e -> Bool) -> Vector r e -> Vector r e dropWhile f v = drop (go 0) v where !k = elemsCount v @@ -911,7 +897,7 @@ dropWhile f v = drop (go 0) v -- -- @since 0.5.0 sdrop :: Stream r Ix1 e => Sz1 -> Vector r e -> Vector DS e -sdrop n = fromSteps . S.drop (unSz n) . S.toStream +sdrop n = fromSteps . S.drop n . S.toStream {-# INLINE sdrop #-} -- | @@ -919,7 +905,7 @@ sdrop n = fromSteps . S.drop (unSz n) . S.toStream -- ==== __Examples__ -- -- @since 0.5.0 -drop' :: Source r Ix1 e => Sz1 -> Vector r e -> Vector r e +drop' :: Source r e => Sz1 -> Vector r e -> Vector r e drop' k = either throw id . dropM k {-# INLINE drop' #-} @@ -928,7 +914,7 @@ drop' k = either throw id . dropM k -- ==== __Examples__ -- -- @since 0.5.0 -dropM :: (Source r Ix1 e, MonadThrow m) => Sz1 -> Vector r e -> m (Vector r e) +dropM :: (Source r e, MonadThrow m) => Sz1 -> Vector r e -> m (Vector r e) dropM k@(Sz d) v = do let sz@(Sz n) = size v when (k > sz) $ throwM $ SizeSubregionException sz d (sz - k) @@ -942,7 +928,7 @@ dropM k@(Sz d) v = do -- ==== __Examples__ -- -- @since 0.5.0 -sliceAt :: Source r Ix1 e => Sz1 -> Vector r e -> (Vector r e, Vector r e) +sliceAt :: Source r e => Sz1 -> Vector r e -> (Vector r e, Vector r e) sliceAt (Sz k) v = (unsafeTake d v, unsafeDrop d v) where !n = coerce (size v) @@ -954,7 +940,7 @@ sliceAt (Sz k) v = (unsafeTake d v, unsafeDrop d v) -- ==== __Examples__ -- -- @since 0.5.0 -sliceAt' :: Source r Ix1 e => Sz1 -> Vector r e -> (Vector r e, Vector r e) +sliceAt' :: Source r e => Sz1 -> Vector r e -> (Vector r e, Vector r e) sliceAt' k = either throw id . sliceAtM k {-# INLINE sliceAt' #-} @@ -963,7 +949,7 @@ sliceAt' k = either throw id . sliceAtM k -- ==== __Examples__ -- -- @since 0.5.0 -sliceAtM :: (Source r Ix1 e, MonadThrow m) => Sz1 -> Vector r e -> m (Vector r e, Vector r e) +sliceAtM :: (Source r e, MonadThrow m) => Sz1 -> Vector r e -> m (Vector r e, Vector r e) sliceAtM k v = do l <- takeM k v pure (l, unsafeDrop k v) @@ -991,7 +977,7 @@ ssingleton = DSArray . S.singleton -- | /O(1)/ - Add an element to the vector from the left side -- -- @since 0.3.0 -cons :: Load r Ix1 e => e -> Vector r e -> Vector DL e +cons :: (Size r, Load r Ix1 e) => e -> Vector r e -> Vector DL e cons e v = let dv = toLoadArray v load scheduler startAt uWrite uSet = @@ -1003,7 +989,7 @@ cons e v = -- | /O(1)/ - Add an element to the vector from the right side -- -- @since 0.3.0 -snoc :: Load r Ix1 e => Vector r e -> e -> Vector DL e +snoc :: (Size r, Load r Ix1 e) => Vector r e -> e -> Vector DL e snoc v e = let dv = toLoadArray v !k = unSz (size dv) @@ -1021,7 +1007,7 @@ snoc v e = -- -- @since 0.5.0 sreplicate :: Sz1 -> e -> Vector DS e -sreplicate (Sz n) = DSArray . S.replicate n +sreplicate n = DSArray . S.replicate n {-# INLINE sreplicate #-} -- | Create a delayed vector of length @n@ with a function that maps an index to an @@ -1041,7 +1027,7 @@ generate = makeArrayLinear -- -- @since 0.5.0 sgenerate :: Sz1 -> (Ix1 -> e) -> Vector DS e -sgenerate (Sz n) = DSArray . S.generate n +sgenerate n = DSArray . S.generate n {-# INLINE sgenerate #-} @@ -1070,7 +1056,7 @@ siterate f = fromSteps . S.unfoldr (\a -> Just (a, f a)) -- -- @since 0.5.0 siterateN :: Sz1 -> (e -> e) -> e -> Vector DS e -siterateN n f a = fromSteps $ S.iterateN (unSz n) f a +siterateN n f a = fromSteps $ S.iterateN n f a {-# INLINE siterateN #-} @@ -1080,7 +1066,7 @@ siterateN n f a = fromSteps $ S.iterateN (unSz n) f a -- -- @since 0.5.0 sreplicateM :: Monad m => Sz1 -> m e -> m (Vector DS e) -sreplicateM n f = fromStepsM $ S.replicateM (unSz n) f +sreplicateM n f = fromStepsM $ S.replicateM n f {-# INLINE sreplicateM #-} @@ -1091,7 +1077,7 @@ sreplicateM n f = fromStepsM $ S.replicateM (unSz n) f -- -- @since 0.5.0 sgenerateM :: Monad m => Sz1 -> (Ix1 -> m e) -> m (Vector DS e) -sgenerateM n f = fromStepsM $ S.generateM (unSz n) f +sgenerateM n f = fromStepsM $ S.generateM n f {-# INLINE sgenerateM #-} @@ -1102,7 +1088,7 @@ sgenerateM n f = fromStepsM $ S.generateM (unSz n) f -- -- @since 0.5.0 siterateNM :: Monad m => Sz1 -> (e -> m e) -> e -> m (Vector DS e) -siterateNM n f a = fromStepsM $ S.iterateNM (unSz n) f a +siterateNM n f a = fromStepsM $ S.iterateNM n f a {-# INLINE siterateNM #-} @@ -1143,7 +1129,7 @@ sunfoldrN :: -- is reached. -> s -- ^ Inititial element. -> Vector DS e -sunfoldrN (Sz n) f = DSArray . S.unfoldrN n f +sunfoldrN n f = DSArray . S.unfoldrN n f {-# INLINE sunfoldrN #-} -- | /O(n)/ - Same as `unfoldr`, but with monadic generating function. @@ -1199,7 +1185,7 @@ sunfoldrNM (Sz n) f = fromStepsM . S.unfoldrNM n f -- -- @since 0.5.0 sunfoldrExactN :: Sz1 -> (s -> (e, s)) -> s -> Vector DS e -sunfoldrExactN (Sz n) f = fromSteps . S.unfoldrExactN n f +sunfoldrExactN n f = fromSteps . S.unfoldrExactN n f {-# INLINE sunfoldrExactN #-} -- | /O(n)/ - Similar to `unfoldrNM`, except the length of the resulting vector will be exactly @n@ @@ -1217,7 +1203,7 @@ sunfoldrExactN (Sz n) f = fromSteps . S.unfoldrExactN n f -- -- @since 0.5.0 sunfoldrExactNM :: Monad m => Sz1 -> (s -> m (e, s)) -> s -> m (Vector DS e) -sunfoldrExactNM (Sz n) f = fromStepsM . S.unfoldrExactNM n f +sunfoldrExactNM n f = fromStepsM . S.unfoldrExactNM n f {-# INLINE sunfoldrExactNM #-} @@ -1246,7 +1232,7 @@ senumFromN :: => e -- ^ @x@ - starting number -> Sz1 -- ^ @n@ - length of resulting vector -> Vector DS e -senumFromN x (Sz n) = DSArray $ S.enumFromStepN x 1 n +senumFromN x n = DSArray $ S.enumFromStepN x 1 n {-# INLINE senumFromN #-} -- | /O(n)/ - Enumerate from a starting number @x@ exactly @n@ times with a custom step value @dx@ @@ -1272,7 +1258,7 @@ senumFromStepN :: -> e -- ^ @dx@ - Step -> Sz1 -- ^ @n@ - length of resulting vector -> Vector DS e -senumFromStepN x step (Sz n) = DSArray $ S.enumFromStepN x step n +senumFromStepN x step n = DSArray $ S.enumFromStepN x step n {-# INLINE senumFromStepN #-} @@ -2371,8 +2357,8 @@ sfoldl1' f = either throw id . sfoldl1M (\e -> pure . f e) sfoldl1M :: (Stream r ix e, MonadThrow m) => (e -> e -> m e) -> Array r ix e -> m e sfoldl1M f arr = do let str = S.transStepsId $ toStream arr - nullStream <- S.null str - when nullStream $ throwM $ SizeEmptyException (size arr) + isNullStream <- S.null str + when isNullStream $ throwM $ SizeEmptyException (outerSize arr) S.foldl1M f str {-# INLINE sfoldl1M #-} @@ -2559,135 +2545,3 @@ sminimum' = sfoldl1' min sminimumM :: (Ord e, Stream r ix e, MonadThrow m) => Array r ix e -> m e sminimumM = sfoldl1M (\e acc -> pure (min e acc)) {-# INLINE sminimumM #-} - - --- | See `stake`. --- --- @since 0.4.1 -takeS :: Stream r ix e => Sz1 -> Array r ix e -> Array DS Ix1 e -takeS n = fromSteps . S.take (unSz n) . S.toStream -{-# INLINE takeS #-} -{-# DEPRECATED takeS "In favor of `stake`" #-} - --- | See `sdrop`. --- --- @since 0.4.1 -dropS :: Stream r ix e => Sz1 -> Array r ix e -> Array DS Ix1 e -dropS n = fromSteps . S.drop (unSz n) . S.toStream -{-# INLINE dropS #-} -{-# DEPRECATED dropS "In favor of `sdrop`" #-} - --- | See `sunfoldr` --- --- @since 0.4.1 -unfoldr :: (s -> Maybe (e, s)) -> s -> Vector DS e -unfoldr = sunfoldr -{-# INLINE unfoldr #-} -{-# DEPRECATED unfoldr "In favor of `sunfoldr`" #-} - - --- | See `sunfoldrN` --- --- @since 0.4.1 -unfoldrN :: Sz1 -> (s -> Maybe (e, s)) -> s -> Vector DS e -unfoldrN = unfoldrN -{-# INLINE unfoldrN #-} -{-# DEPRECATED unfoldrN "In favor of `sunfoldrN`" #-} - - --- | See `sfilterM` --- --- @since 0.4.1 -filterM :: (S.Stream r ix e, Applicative f) => (e -> f Bool) -> Array r ix e -> f (Vector DS e) -filterM f arr = DSArray <$> S.filterA f (S.toStream arr) -{-# INLINE filterM #-} -{-# DEPRECATED filterM "In favor of `sfilterM`" #-} - --- | See `sfilter` --- --- @since 0.4.1 -filterS :: S.Stream r ix e => (e -> Bool) -> Array r ix e -> Array DS Ix1 e -filterS = sfilter -{-# INLINE filterS #-} -{-# DEPRECATED filterS "In favor of `sfilter`" #-} - - --- | See `smapMaybe` --- --- @since 0.4.1 -mapMaybeS :: S.Stream r ix a => (a -> Maybe b) -> Array r ix a -> Vector DS b -mapMaybeS = smapMaybe -{-# INLINE mapMaybeS #-} -{-# DEPRECATED mapMaybeS "In favor of `smapMaybe`" #-} - --- | See `scatMaybes` --- --- @since 0.4.4 -catMaybesS :: S.Stream r ix (Maybe a) => Array r ix (Maybe a) -> Vector DS a -catMaybesS = scatMaybes -{-# INLINE catMaybesS #-} -{-# DEPRECATED catMaybesS "In favor of `scatMaybes`" #-} - --- | See `smapMaybeM` --- --- @since 0.4.1 -mapMaybeM :: - (S.Stream r ix a, Applicative f) => (a -> f (Maybe b)) -> Array r ix a -> f (Vector DS b) -mapMaybeM = smapMaybeM -{-# INLINE mapMaybeM #-} -{-# DEPRECATED mapMaybeM "In favor of `smapMaybeM`" #-} - --- | See `traverseS` --- --- @since 0.4.5 -traverseS :: (S.Stream r ix a, Applicative f) => (a -> f b) -> Array r ix a -> f (Vector DS b) -traverseS = straverse -{-# INLINE traverseS #-} -{-# DEPRECATED traverseS "In favor of `straverse`" #-} - --- | See `simapMaybe` --- --- @since 0.4.1 -imapMaybeS :: Source r ix a => (ix -> a -> Maybe b) -> Array r ix a -> Array DS Ix1 b -imapMaybeS f arr = - mapMaybeS (uncurry f) $ A.makeArrayR D (getComp arr) (size arr) $ \ix -> (ix, unsafeIndex arr ix) -{-# INLINE imapMaybeS #-} -{-# DEPRECATED imapMaybeS "In favor of `simapMaybe`" #-} - --- | See `simapMaybeM` --- --- @since 0.4.1 -imapMaybeM :: - (Source r ix a, Applicative f) => (ix -> a -> f (Maybe b)) -> Array r ix a -> f (Array DS Ix1 b) -imapMaybeM f arr = - mapMaybeM (uncurry f) $ A.makeArrayR D (getComp arr) (size arr) $ \ix -> (ix, unsafeIndex arr ix) -{-# INLINE imapMaybeM #-} -{-# DEPRECATED imapMaybeM "In favor of `simapMaybeM`" #-} - --- | Similar to `filterS`, but map with an index aware function. --- --- @since 0.4.1 -ifilterS :: Source r ix a => (ix -> a -> Bool) -> Array r ix a -> Array DS Ix1 a -ifilterS f = - imapMaybeS $ \ix e -> - if f ix e - then Just e - else Nothing -{-# INLINE ifilterS #-} -{-# DEPRECATED ifilterS "In favor of `sifilter`" #-} - - --- | Similar to `filterM`, but map with an index aware function. --- --- @since 0.4.1 -ifilterM :: - (Source r ix a, Applicative f) => (ix -> a -> f Bool) -> Array r ix a -> f (Array DS Ix1 a) -ifilterM f = - imapMaybeM $ \ix e -> - (\p -> - if p - then Just e - else Nothing) <$> - f ix e -{-# INLINE ifilterM #-} -{-# DEPRECATED ifilterM "In favor of `sifilterM`" #-} diff --git a/massiv/src/Data/Massiv/Vector/Stream.hs b/massiv/src/Data/Massiv/Vector/Stream.hs index ad974870..afd324ac 100644 --- a/massiv/src/Data/Massiv/Vector/Stream.hs +++ b/massiv/src/Data/Massiv/Vector/Stream.hs @@ -1,8 +1,10 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_HADDOCK hide, not-home #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -123,7 +125,6 @@ module Data.Massiv.Vector.Stream , transSteps , transStepsId -- * Useful re-exports - , module Data.Vector.Fusion.Bundle.Size , module Data.Vector.Fusion.Util , Id(..) ) where @@ -132,10 +133,11 @@ import qualified Control.Monad as M import Control.Monad.ST import qualified Data.Foldable as F import Data.Massiv.Core.Common hiding (empty, singleton, replicate) +import Data.Coerce import Data.Maybe (catMaybes) import qualified Data.Traversable as Traversable (traverse) import qualified Data.Vector.Fusion.Bundle.Monadic as B -import Data.Vector.Fusion.Bundle.Size +import qualified Data.Vector.Fusion.Bundle.Size as B import qualified Data.Vector.Fusion.Stream.Monadic as S import Data.Vector.Fusion.Util import Prelude hiding (and, concatMap, drop, filter, foldl, foldl1, foldr, @@ -148,8 +150,8 @@ instance Monad m => Functor (Steps m) where {-# INLINE fmap #-} (<$) e str = case stepsSize str of - Exact n -> str {stepsStream = S.replicate n e} - _ -> fmap (const e) str + LengthExact n -> str {stepsStream = S.replicate (coerce n) e} + _ -> fmap (const e) str {-# INLINE (<$) #-} instance Monad m => Semigroup (Steps m e) where @@ -191,8 +193,8 @@ instance Foldable (Steps Id) where -- TODO: benchmark: `fmap snd . isteps` -steps :: forall r ix e m . (Monad m, Source r ix e) => Array r ix e -> Steps m e -steps arr = k `seq` arr `seq` Steps (S.Stream step 0) (Exact k) +steps :: forall r ix e m . (Monad m, Index ix, Source r e) => Array r ix e -> Steps m e +steps arr = k `seq` arr `seq` Steps (S.Stream step 0) (LengthExact (coerce k)) where k = totalElem $ size arr step i @@ -204,8 +206,8 @@ steps arr = k `seq` arr `seq` Steps (S.Stream step 0) (Exact k) {-# INLINE steps #-} -isteps :: forall r ix e m . (Monad m, Source r ix e) => Array r ix e -> Steps m (ix, e) -isteps arr = k `seq` arr `seq` Steps (S.Stream step 0) (Exact k) +isteps :: forall r ix e m . (Monad m, Index ix, Source r e) => Array r ix e -> Steps m (ix, e) +isteps arr = k `seq` arr `seq` Steps (S.Stream step 0) (LengthExact (coerce k)) where sz = size arr k = totalElem sz @@ -217,39 +219,39 @@ isteps arr = k `seq` arr `seq` Steps (S.Stream step 0) (Exact k) {-# INLINE step #-} {-# INLINE isteps #-} -toBundle :: (Monad m, Source r ix e) => Array r ix e -> B.Bundle m v e +toBundle :: (Monad m, Index ix, Source r e) => Array r ix e -> B.Bundle m v e toBundle arr = let Steps str k = steps arr - in B.fromStream str k + in B.fromStream str (sizeHintToBundleSize k) {-# INLINE toBundle #-} -fromBundle :: Mutable r Ix1 e => B.Bundle Id v e -> Array r Ix1 e +fromBundle :: Mutable r e => B.Bundle Id v e -> Vector r e fromBundle bundle = fromStream (B.sSize bundle) (B.sElems bundle) {-# INLINE fromBundle #-} -fromBundleM :: (Monad m, Mutable r Ix1 e) => B.Bundle m v e -> m (Array r Ix1 e) +fromBundleM :: (Monad m, Mutable r e) => B.Bundle m v e -> m (Vector r e) fromBundleM bundle = fromStreamM (B.sSize bundle) (B.sElems bundle) {-# INLINE fromBundleM #-} -fromStream :: forall r e . Mutable r Ix1 e => Size -> S.Stream Id e -> Array r Ix1 e +fromStream :: forall r e . Mutable r e => B.Size -> S.Stream Id e -> Vector r e fromStream sz str = - case upperBound sz of + case B.upperBound sz of Nothing -> unstreamUnknown str Just k -> unstreamMax k str {-# INLINE fromStream #-} -fromStreamM :: forall r e m. (Monad m, Mutable r Ix1 e) => Size -> S.Stream m e -> m (Array r Ix1 e) +fromStreamM :: forall r e m. (Monad m, Mutable r e) => B.Size -> S.Stream m e -> m (Vector r e) fromStreamM sz str = do xs <- S.toList str - case upperBound sz of + case B.upperBound sz of Nothing -> pure $! unstreamUnknown (S.fromList xs) Just k -> pure $! unstreamMax k (S.fromList xs) {-# INLINE fromStreamM #-} fromStreamExactM :: - forall r ix e m. (Monad m, Mutable r ix e) + forall r ix e m. (Monad m, Mutable r e, Index ix) => Sz ix -> S.Stream m e -> m (Array r ix e) @@ -260,25 +262,25 @@ fromStreamExactM sz str = do unstreamIntoM :: - (Mutable r Ix1 a, PrimMonad m) - => MArray (PrimState m) r Ix1 a - -> Size + (Mutable r a, PrimMonad m) + => MVector (PrimState m) r a + -> LengthHint -> S.Stream Id a - -> m (MArray (PrimState m) r Ix1 a) + -> m (MVector (PrimState m) r a) unstreamIntoM marr sz str = case sz of - Exact _ -> marr <$ unstreamMaxM marr str - Max _ -> unsafeLinearShrink marr . SafeSz =<< unstreamMaxM marr str - Unknown -> unstreamUnknownM marr str + LengthExact _ -> marr <$ unstreamMaxM marr str + LengthMax _ -> unsafeLinearShrink marr . SafeSz =<< unstreamMaxM marr str + LengthUnknown -> unstreamUnknownM marr str {-# INLINE unstreamIntoM #-} unstreamMax :: - forall r e. (Mutable r Ix1 e) + forall r e. (Mutable r e) => Int -> S.Stream Id e - -> Array r Ix1 e + -> Vector r e unstreamMax kMax str = runST $ do marr <- unsafeNew (SafeSz kMax) @@ -288,7 +290,7 @@ unstreamMax kMax str = unstreamMaxM :: - (Mutable r ix a, PrimMonad m) => MArray (PrimState m) r ix a -> S.Stream Id a -> m Int + (Mutable r a, Index ix, PrimMonad m) => MArray (PrimState m) r ix a -> S.Stream Id a -> m Int unstreamMaxM marr (S.Stream step s) = stepLoad s 0 where stepLoad t i = @@ -302,7 +304,7 @@ unstreamMaxM marr (S.Stream step s) = stepLoad s 0 {-# INLINE unstreamMaxM #-} -unstreamUnknown :: Mutable r Ix1 a => S.Stream Id a -> Array r Ix1 a +unstreamUnknown :: Mutable r a => S.Stream Id a -> Vector r a unstreamUnknown str = runST $ do marr <- unsafeNew zeroSz @@ -311,10 +313,10 @@ unstreamUnknown str = unstreamUnknownM :: - (Mutable r Ix1 a, PrimMonad m) - => MArray (PrimState m) r Ix1 a + (Mutable r a, PrimMonad m) + => MVector (PrimState m) r a -> S.Stream Id a - -> m (MArray (PrimState m) r Ix1 a) + -> m (MVector (PrimState m) r a) unstreamUnknownM marrInit (S.Stream step s) = stepLoad s 0 (unSz (msize marrInit)) marrInit where stepLoad t i kMax marr @@ -334,7 +336,7 @@ unstreamUnknownM marrInit (S.Stream step s) = stepLoad s 0 (unSz (msize marrInit unstreamExact :: - forall r ix e. (Mutable r ix e) + forall r ix e. (Mutable r e, Index ix) => Sz ix -> S.Stream Id e -> Array r ix e @@ -348,28 +350,28 @@ unstreamExact sz str = length :: Monad m => Steps m a -> m Int length (Steps str sz) = case sz of - Exact k -> pure k - _ -> S.length str + LengthExact k -> pure $ coerce k + _ -> S.length str {-# INLINE length #-} null :: Monad m => Steps m a -> m Bool null (Steps str sz) = case sz of - Exact k -> pure (k == 0) - _ -> S.null str + LengthExact k -> pure (k == 0) + _ -> S.null str {-# INLINE null #-} empty :: Monad m => Steps m e -empty = Steps S.empty (Exact 0) +empty = Steps S.empty (LengthExact 0) {-# INLINE empty #-} singleton :: Monad m => e -> Steps m e -singleton e = Steps (S.singleton e) (Exact 1) +singleton e = Steps (S.singleton e) (LengthExact 1) {-# INLINE singleton #-} -generate :: Monad m => Int -> (Int -> e) -> Steps m e -generate k f = Steps (S.generate k f) (Exact k) +generate :: Monad m => Sz1 -> (Int -> e) -> Steps m e +generate k f = Steps (S.generate (coerce k) f) (LengthExact k) {-# INLINE generate #-} -- | First element of the 'Stream' or error if empty @@ -387,16 +389,16 @@ headMaybe (Steps (S.Stream step t) _) = headMaybeLoop S.SPEC t cons :: Monad m => e -> Steps m e -> Steps m e -cons e (Steps str k) = Steps (S.cons e str) (k + 1) +cons e (Steps str k) = Steps (S.cons e str) (k `addInt` 1) {-# INLINE cons #-} -- | First element of the `Steps` or `Nothing` if empty uncons :: Monad m => Steps m e -> m (Maybe (e, Steps m e)) -uncons sts = (\mx -> (\x -> (x, drop 1 sts)) <$> mx) <$> headMaybe sts +uncons sts = (\mx -> (, drop 1 sts) <$> mx) <$> headMaybe sts {-# INLINE uncons #-} snoc :: Monad m => Steps m e -> e -> Steps m e -snoc (Steps str k) e = Steps (S.snoc str e) (k + 1) +snoc (Steps str k) e = Steps (S.snoc str e) (k `addInt` 1) {-# INLINE snoc #-} traverse :: (Monad m, Applicative f) => (e -> f a) -> Steps Id e -> f (Steps m a) @@ -404,7 +406,7 @@ traverse f (Steps str k) = (`Steps` k) <$> liftListA (Traversable.traverse f) st {-# INLINE traverse #-} append :: Monad m => Steps m e -> Steps m e -> Steps m e -append (Steps str1 k1) (Steps str2 k2) = Steps (str1 S.++ str2) (k1 + k2) +append (Steps str1 k1) (Steps str2 k2) = Steps (str1 S.++ str2) (k1 `addLengthHint` k2) {-# INLINE append #-} map :: Monad m => (e -> a) -> Steps m e -> Steps m a @@ -424,18 +426,18 @@ mapM_ f (Steps str _) = S.mapM_ f str {-# INLINE mapM_ #-} zipWith :: Monad m => (a -> b -> e) -> Steps m a -> Steps m b -> Steps m e -zipWith f (Steps sa ka) (Steps sb kb) = Steps (S.zipWith f sa sb) (smaller ka kb) +zipWith f (Steps sa ka) (Steps sb kb) = Steps (S.zipWith f sa sb) (minLengthHint ka kb) {-# INLINE zipWith #-} zipWith3 :: Monad m => (a -> b -> c -> d) -> Steps m a -> Steps m b -> Steps m c -> Steps m d zipWith3 f (Steps sa ka) (Steps sb kb) (Steps sc kc) = - Steps (S.zipWith3 f sa sb sc) (smaller ka (smaller kb kc)) + Steps (S.zipWith3 f sa sb sc) (minLengthHint ka (minLengthHint kb kc)) {-# INLINE zipWith3 #-} zipWith4 :: Monad m => (a -> b -> c -> d -> e) -> Steps m a -> Steps m b -> Steps m c -> Steps m d -> Steps m e zipWith4 f (Steps sa ka) (Steps sb kb) (Steps sc kc) (Steps sd kd) = - Steps (S.zipWith4 f sa sb sc sd) (smaller ka (smaller kb (smaller kc kd))) + Steps (S.zipWith4 f sa sb sc sd) (minLengthHint ka (minLengthHint kb (minLengthHint kc kd))) {-# INLINE zipWith4 #-} zipWith5 :: @@ -448,7 +450,7 @@ zipWith5 :: -> Steps m e -> Steps m f zipWith5 f (Steps sa ka) (Steps sb kb) (Steps sc kc) (Steps sd kd) (Steps se ke) = - Steps (S.zipWith5 f sa sb sc sd se) (smaller ka (smaller kb (smaller kc (smaller kd ke)))) + Steps (S.zipWith5 f sa sb sc sd se) (minLengthHint ka (minLengthHint kb (minLengthHint kc (minLengthHint kd ke)))) {-# INLINE zipWith5 #-} zipWith6 :: @@ -464,17 +466,17 @@ zipWith6 :: zipWith6 f (Steps sa ka) (Steps sb kb) (Steps sc kc) (Steps sd kd) (Steps se ke) (Steps sf kf) = Steps (S.zipWith6 f sa sb sc sd se sf) - (smaller ka (smaller kb (smaller kc (smaller kd (smaller ke kf))))) + (minLengthHint ka (minLengthHint kb (minLengthHint kc (minLengthHint kd (minLengthHint ke kf))))) {-# INLINE zipWith6 #-} zipWithM :: Monad m => (a -> b -> m c) -> Steps m a -> Steps m b -> Steps m c -zipWithM f (Steps sa ka) (Steps sb kb) = Steps (S.zipWithM f sa sb) (smaller ka kb) +zipWithM f (Steps sa ka) (Steps sb kb) = Steps (S.zipWithM f sa sb) (minLengthHint ka kb) {-# INLINE zipWithM #-} zipWith3M :: Monad m => (a -> b -> c -> m d) -> Steps m a -> Steps m b -> Steps m c -> Steps m d zipWith3M f (Steps sa ka) (Steps sb kb) (Steps sc kc) = - Steps (S.zipWith3M f sa sb sc) (smaller ka (smaller kb kc)) + Steps (S.zipWith3M f sa sb sc) (minLengthHint ka (minLengthHint kb kc)) {-# INLINE zipWith3M #-} zipWith4M :: @@ -486,7 +488,7 @@ zipWith4M :: -> Steps m d -> Steps m e zipWith4M f (Steps sa ka) (Steps sb kb) (Steps sc kc) (Steps sd kd) = - Steps (S.zipWith4M f sa sb sc sd) (smaller ka (smaller kb (smaller kc kd))) + Steps (S.zipWith4M f sa sb sc sd) (minLengthHint ka (minLengthHint kb (minLengthHint kc kd))) {-# INLINE zipWith4M #-} zipWith5M :: @@ -499,7 +501,7 @@ zipWith5M :: -> Steps m e -> Steps m f zipWith5M f (Steps sa ka) (Steps sb kb) (Steps sc kc) (Steps sd kd) (Steps se ke) = - Steps (S.zipWith5M f sa sb sc sd se) (smaller ka (smaller kb (smaller kc (smaller kd ke)))) + Steps (S.zipWith5M f sa sb sc sd se) (minLengthHint ka (minLengthHint kb (minLengthHint kc (minLengthHint kd ke)))) {-# INLINE zipWith5M #-} zipWith6M :: @@ -515,7 +517,7 @@ zipWith6M :: zipWith6M f (Steps sa ka) (Steps sb kb) (Steps sc kc) (Steps sd kd) (Steps se ke) (Steps sf kf) = Steps (S.zipWith6M f sa sb sc sd se sf) - (smaller ka (smaller kb (smaller kc (smaller kd (smaller ke kf))))) + (minLengthHint ka (minLengthHint kb (minLengthHint kc (minLengthHint kd (minLengthHint ke kf))))) {-# INLINE zipWith6M #-} @@ -582,10 +584,10 @@ transStepsId (Steps sts k) = Steps (S.trans (pure . unId) sts) k {-# INLINE transStepsId #-} transSteps :: (Monad m, Monad n) => Steps m e -> m (Steps n e) -transSteps (Steps strM sz@(Exact _)) = (`Steps` sz) <$> transListM strM +transSteps (Steps strM sz@(LengthExact _)) = (`Steps` sz) <$> transListM strM transSteps (Steps strM _) = do (n, strN) <- transListNM strM - pure (Steps strN (Exact n)) + pure (Steps strN (LengthExact n)) {-# INLINE transSteps #-} @@ -655,20 +657,20 @@ and = S.and . stepsStream mapMaybe :: Monad m => (a -> Maybe e) -> Steps m a -> Steps m e -mapMaybe f (Steps str k) = Steps (S.mapMaybe f str) (toMax k) +mapMaybe f (Steps str k) = Steps (S.mapMaybe f str) (toLengthMax k) {-# INLINE mapMaybe #-} concatMap :: Monad m => (a -> Steps m e) -> Steps m a -> Steps m e -concatMap f (Steps str _) = Steps (S.concatMap (stepsStream . f) str) Unknown +concatMap f (Steps str _) = Steps (S.concatMap (stepsStream . f) str) LengthUnknown {-# INLINE concatMap #-} mapMaybeA :: (Monad m, Applicative f) => (a -> f (Maybe e)) -> Steps Id a -> f (Steps m e) -mapMaybeA f (Steps str k) = (`Steps` toMax k) <$> liftListA (mapMaybeListA f) str +mapMaybeA f (Steps str k) = (`Steps` toLengthMax k) <$> liftListA (mapMaybeListA f) str {-# INLINE mapMaybeA #-} mapMaybeM :: Monad m => (a -> m (Maybe b)) -> Steps m a -> Steps m b -mapMaybeM f (Steps str k) = Steps (mapMaybeStreamM f str) (toMax k) +mapMaybeM f (Steps str k) = Steps (mapMaybeStreamM f str) (toLengthMax k) {-# INLINE mapMaybeM #-} mapMaybeListA :: Applicative f => (a -> f (Maybe b)) -> [a] -> f [b] @@ -693,87 +695,87 @@ mapMaybeStreamM f (S.Stream step t) = S.Stream step' t {-# INLINE mapMaybeStreamM #-} filter :: Monad m => (a -> Bool) -> Steps m a -> Steps m a -filter f (Steps str k) = Steps (S.filter f str) (toMax k) +filter f (Steps str k) = Steps (S.filter f str) (toLengthMax k) {-# INLINE filter #-} filterA :: (Monad m, Applicative f) => (e -> f Bool) -> Steps Id e -> f (Steps m e) -filterA f (Steps str k) = (`Steps` toMax k) <$> liftListA (M.filterM f) str +filterA f (Steps str k) = (`Steps` toLengthMax k) <$> liftListA (M.filterM f) str {-# INLINE filterA #-} filterM :: Monad m => (e -> m Bool) -> Steps m e -> Steps m e -filterM f (Steps str k) = Steps (S.filterM f str) (toMax k) +filterM f (Steps str k) = Steps (S.filterM f str) (toLengthMax k) {-# INLINE filterM #-} -take :: Monad m => Int -> Steps m a -> Steps m a +take :: Monad m => Sz1 -> Steps m a -> Steps m a take n (Steps str sz) = - Steps (S.take n str) $! + Steps (S.take (coerce n) str) $! case sz of - Exact k -> Exact (min n k) - Max k -> Max (min n k) - Unknown -> Unknown + LengthExact k -> LengthExact (inline0 min n k) + LengthMax k -> LengthMax (inline0 min n k) + LengthUnknown -> LengthUnknown {-# INLINE take #-} -drop :: Monad m => Int -> Steps m a -> Steps m a -drop n (Steps str k) = Steps (S.drop n str) (k `clampedSubtract` Exact n) +drop :: Monad m => Sz1 -> Steps m a -> Steps m a +drop n (Steps str k) = Steps (S.drop (coerce n) str) (k `subtractLengthHint` LengthExact n) {-# INLINE drop #-} -slice :: Monad m => Int -> Int -> Steps m a -> Steps m a -slice i k (Steps str _) = Steps (S.slice i k str) (Max k) +slice :: Monad m => Int -> Sz1 -> Steps m a -> Steps m a +slice i k (Steps str _) = Steps (S.slice i (coerce k) str) (LengthMax k) {-# INLINE slice #-} -iterateN :: Monad m => Int -> (a -> a) -> a -> Steps m a -iterateN n f a = Steps (S.iterateN n f a) (Exact n) +iterateN :: Monad m => Sz1 -> (a -> a) -> a -> Steps m a +iterateN n f a = Steps (S.iterateN (coerce n) f a) (LengthExact n) {-# INLINE iterateN #-} -iterateNM :: Monad m => Int -> (a -> m a) -> a -> Steps m a -iterateNM n f a = Steps (S.iterateNM n f a) (Exact n) +iterateNM :: Monad m => Sz1 -> (a -> m a) -> a -> Steps m a +iterateNM n f a = Steps (S.iterateNM (coerce n) f a) (LengthExact n) {-# INLINE iterateNM #-} -replicate :: Monad m => Int -> a -> Steps m a -replicate n a = Steps (S.replicate n a) (Exact n) +replicate :: Monad m => Sz1 -> a -> Steps m a +replicate n a = Steps (S.replicate (coerce n) a) (LengthExact n) {-# INLINE replicate #-} -replicateM :: Monad m => Int -> m a -> Steps m a -replicateM n f = Steps (S.replicateM n f) (Exact n) +replicateM :: Monad m => Sz1 -> m a -> Steps m a +replicateM n f = Steps (S.replicateM (coerce n) f) (LengthExact n) {-# INLINE replicateM #-} -generateM :: Monad m => Int -> (Int -> m a) -> Steps m a -generateM n f = Steps (S.generateM n f) (Exact n) +generateM :: Monad m => Sz1 -> (Int -> m a) -> Steps m a +generateM n f = Steps (S.generateM (coerce n) f) (LengthExact n) {-# INLINE generateM #-} unfoldr :: Monad m => (s -> Maybe (e, s)) -> s -> Steps m e -unfoldr f e0 = Steps (S.unfoldr f e0) Unknown +unfoldr f e0 = Steps (S.unfoldr f e0) LengthUnknown {-# INLINE unfoldr #-} -unfoldrN :: Monad m => Int -> (s -> Maybe (e, s)) -> s -> Steps m e -unfoldrN n f e0 = Steps (S.unfoldrN n f e0) Unknown +unfoldrN :: Monad m => Sz1 -> (s -> Maybe (e, s)) -> s -> Steps m e +unfoldrN n f e0 = Steps (S.unfoldrN (coerce n) f e0) LengthUnknown {-# INLINE unfoldrN #-} -unsafeUnfoldrN :: Monad m => Int -> (s -> Maybe (e, s)) -> s -> Steps m e -unsafeUnfoldrN n f e0 = Steps (S.unfoldrN n f e0) (Max n) +unsafeUnfoldrN :: Monad m => Sz1 -> (s -> Maybe (e, s)) -> s -> Steps m e +unsafeUnfoldrN n f e0 = Steps (S.unfoldrN (coerce n) f e0) (LengthMax n) {-# INLINE unsafeUnfoldrN #-} unfoldrM :: Monad m => (s -> m (Maybe (e, s))) -> s -> Steps m e -unfoldrM f e0 = Steps (S.unfoldrM f e0) Unknown +unfoldrM f e0 = Steps (S.unfoldrM f e0) LengthUnknown {-# INLINE unfoldrM #-} unfoldrNM :: Monad m => Int -> (s -> m (Maybe (e, s))) -> s -> Steps m e -unfoldrNM n f e0 = Steps (S.unfoldrNM n f e0) Unknown +unfoldrNM n f e0 = Steps (S.unfoldrNM n f e0) LengthUnknown {-# INLINE unfoldrNM #-} -unsafeUnfoldrNM :: Monad m => Int -> (s -> m (Maybe (e, s))) -> s -> Steps m e -unsafeUnfoldrNM n f e0 = Steps (S.unfoldrNM n f e0) (Max n) +unsafeUnfoldrNM :: Monad m => Sz1 -> (s -> m (Maybe (e, s))) -> s -> Steps m e +unsafeUnfoldrNM n f e0 = Steps (S.unfoldrNM (coerce n) f e0) (LengthMax n) {-# INLINE unsafeUnfoldrNM #-} -unfoldrExactN :: Monad m => Int -> (s -> (a, s)) -> s -> Steps m a +unfoldrExactN :: Monad m => Sz1 -> (s -> (a, s)) -> s -> Steps m a unfoldrExactN n f = unfoldrExactNM n (pure . f) {-# INLINE unfoldrExactN #-} -unfoldrExactNM :: Monad m => Int -> (s -> m (a, s)) -> s -> Steps m a -unfoldrExactNM n f t = Steps (S.Stream step (t, n)) (Exact n) +unfoldrExactNM :: Monad m => Sz1 -> (s -> m (a, s)) -> s -> Steps m a +unfoldrExactNM n f t = Steps (S.Stream step (t, n)) (LengthExact n) where step (s, i) | i <= 0 = pure S.Done @@ -782,8 +784,8 @@ unfoldrExactNM n f t = Steps (S.Stream step (t, n)) (Exact n) {-# INLINE unfoldrExactNM #-} -enumFromStepN :: (Num a, Monad m) => a -> a -> Int -> Steps m a -enumFromStepN x step k = Steps (S.enumFromStepN x step k) (Exact k) +enumFromStepN :: (Num a, Monad m) => a -> a -> Sz1 -> Steps m a +enumFromStepN x step k = Steps (S.enumFromStepN x step (coerce k)) (LengthExact k) {-# INLINE enumFromStepN #-} @@ -794,15 +796,15 @@ toList (Steps str _) = unId (S.toList str) {-# INLINE toList #-} fromList :: Monad m => [e] -> Steps m e -fromList = (`Steps` Unknown) . S.fromList +fromList = (`Steps` LengthUnknown) . S.fromList {-# INLINE fromList #-} fromListN :: Monad m => Int -> [e] -> Steps m e -fromListN n = (`Steps` Unknown) . S.fromListN n +fromListN n = (`Steps` LengthUnknown) . S.fromListN n {-# INLINE fromListN #-} -unsafeFromListN :: Monad m => Int -> [e] -> Steps m e -unsafeFromListN n = (`Steps` Max n) . S.fromListN n +unsafeFromListN :: Monad m => Sz1 -> [e] -> Steps m e +unsafeFromListN n = (`Steps` LengthMax n) . S.fromListN (coerce n) {-# INLINE unsafeFromListN #-} liftListA :: (Monad m, Functor f) => ([a] -> f [b]) -> S.Stream Id a -> f (S.Stream m b) @@ -816,10 +818,10 @@ transListM str = do pure $ S.fromList xs {-# INLINE transListM #-} -transListNM :: (Monad m, Monad n) => S.Stream m a -> m (Int, S.Stream n a) +transListNM :: (Monad m, Monad n) => S.Stream m a -> m (Sz1, S.Stream n a) transListNM str = do (n, xs) <- toListN str - pure (n, S.fromList xs) + pure (coerce n, S.fromList xs) {-# INLINE transListNM #-} @@ -827,3 +829,65 @@ toListN :: Monad m => S.Stream m a -> m (Int, [a]) toListN = S.foldr (\x (i, xs) -> (i + 1, x:xs)) (0, []) {-# INLINE toListN #-} + +sizeHintToBundleSize :: LengthHint -> B.Size +sizeHintToBundleSize = + \case + LengthExact k -> B.Exact (coerce k) + LengthMax k -> B.Max (coerce k) + LengthUnknown -> B.Unknown +{-# INLINE sizeHintToBundleSize #-} + +addHint :: (Sz1 -> LengthHint) -> Int -> Int -> LengthHint +addHint hint m n + | k == coerce sz = hint sz + | otherwise = LengthUnknown -- overflow + where + k = m + n + sz = Sz k +{-# INLINE addHint #-} + + + +addInt :: LengthHint -> Int -> LengthHint +addInt (LengthExact m) n = addHint LengthExact (coerce m) (coerce n) +addInt (LengthMax m) n = addHint LengthExact (coerce m) n +addInt _ _ = LengthUnknown +{-# INLINE addInt #-} + +addLengthHint :: LengthHint -> LengthHint -> LengthHint +addLengthHint (LengthExact m) (LengthExact n) = addHint LengthExact (coerce m) (coerce n) +addLengthHint (LengthMax m) (LengthExact n) = addHint LengthMax (coerce m) (coerce n) +addLengthHint (LengthExact m) (LengthMax n) = addHint LengthMax (coerce m) (coerce n) +addLengthHint (LengthMax m) (LengthMax n) = addHint LengthMax (coerce m) (coerce n) +addLengthHint _ _ = LengthUnknown +{-# INLINE addLengthHint #-} + +subtractLengthHint :: LengthHint -> LengthHint -> LengthHint +subtractLengthHint (LengthExact m) (LengthExact n) = LengthExact (m - n) +subtractLengthHint (LengthMax m) (LengthExact n) = LengthMax (m - n) +subtractLengthHint (LengthExact m) (LengthMax _) = LengthMax m +subtractLengthHint (LengthMax m) (LengthMax _) = LengthMax m +subtractLengthHint _ _ = LengthUnknown +{-# INLINE subtractLengthHint #-} + + +minLengthHint :: LengthHint -> LengthHint -> LengthHint +minLengthHint (LengthExact m) (LengthExact n) = LengthExact (inline0 min m n) +minLengthHint (LengthExact m) (LengthMax n) = LengthMax (inline0 min m n) +minLengthHint (LengthExact m) LengthUnknown = LengthMax m +minLengthHint (LengthMax m) (LengthExact n) = LengthMax (inline0 min m n) +minLengthHint (LengthMax m) (LengthMax n) = LengthMax (inline0 min m n) +minLengthHint (LengthMax m) LengthUnknown = LengthMax m +minLengthHint LengthUnknown (LengthExact n) = LengthMax n +minLengthHint LengthUnknown (LengthMax n) = LengthMax n +minLengthHint LengthUnknown LengthUnknown = LengthUnknown +{-# INLINE minLengthHint #-} + +toLengthMax :: LengthHint -> LengthHint +toLengthMax (LengthExact n) = LengthMax n +toLengthMax (LengthMax n) = LengthMax n +toLengthMax LengthUnknown = LengthUnknown +{-# INLINE toLengthMax #-} + + diff --git a/massiv/src/Data/Massiv/Vector/Unsafe.hs b/massiv/src/Data/Massiv/Vector/Unsafe.hs index 592aed31..89068d7e 100644 --- a/massiv/src/Data/Massiv/Vector/Unsafe.hs +++ b/massiv/src/Data/Massiv/Vector/Unsafe.hs @@ -56,14 +56,14 @@ import qualified Data.Massiv.Vector.Stream as S -- | -- -- @since 0.5.0 -unsafeHead :: Source r Ix1 e => Vector r e -> e +unsafeHead :: Source r e => Vector r e -> e unsafeHead = (`unsafeLinearIndex` 0) {-# INLINE unsafeHead #-} -- | -- -- @since 0.5.0 -unsafeLast :: Source r Ix1 e => Vector r e -> e +unsafeLast :: Source r e => Vector r e -> e unsafeLast v = unsafeLinearIndex v (max 0 (unSz (size v) - 1)) {-# INLINE unsafeLast #-} @@ -74,7 +74,7 @@ unsafeLast v = unsafeLinearIndex v (max 0 (unSz (size v) - 1)) -- | -- -- @since 0.5.0 -unsafeIndexM :: (Source r Ix1 e, Monad m) => Vector r e -> Ix1 -> m e +unsafeIndexM :: (Source r e, Monad m) => Vector r e -> Ix1 -> m e unsafeIndexM v i = pure $! unsafeLinearIndex v i {-# INLINE unsafeIndexM #-} @@ -82,14 +82,14 @@ unsafeIndexM v i = pure $! unsafeLinearIndex v i -- | -- -- @since 0.5.0 -unsafeHeadM :: Monad m => Source r Ix1 e => Vector r e -> m e +unsafeHeadM :: (Monad m, Source r e) => Vector r e -> m e unsafeHeadM v = pure $! unsafeHead v {-# INLINE unsafeHeadM #-} -- | -- -- @since 0.5.0 -unsafeLastM :: Monad m => Source r Ix1 e => Vector r e -> m e +unsafeLastM :: (Monad m, Source r e) => Vector r e -> m e unsafeLastM v = pure $! unsafeLast v {-# INLINE unsafeLastM #-} @@ -102,7 +102,7 @@ unsafeLastM v = pure $! unsafeLast v -- | -- -- @since 0.5.0 -unsafeInit :: Source r Ix1 e => Vector r e -> Vector r e +unsafeInit :: Source r e => Vector r e -> Vector r e unsafeInit v = unsafeLinearSlice 0 (SafeSz (coerce (size v) - 1)) v {-# INLINE unsafeInit #-} @@ -110,7 +110,7 @@ unsafeInit v = unsafeLinearSlice 0 (SafeSz (coerce (size v) - 1)) v -- | -- -- @since 0.5.0 -unsafeTail :: Source r Ix1 e => Vector r e -> Vector r e +unsafeTail :: Source r e => Vector r e -> Vector r e unsafeTail = unsafeDrop 1 {-# INLINE unsafeTail #-} @@ -118,14 +118,14 @@ unsafeTail = unsafeDrop 1 -- | -- -- @since 0.5.0 -unsafeTake :: Source r Ix1 e => Sz1 -> Vector r e -> Vector r e +unsafeTake :: Source r e => Sz1 -> Vector r e -> Vector r e unsafeTake = unsafeLinearSlice 0 {-# INLINE unsafeTake #-} -- | -- -- @since 0.5.0 -unsafeDrop :: Source r Ix1 e => Sz1 -> Vector r e -> Vector r e +unsafeDrop :: Source r e => Sz1 -> Vector r e -> Vector r e unsafeDrop (Sz d) v = unsafeLinearSlice d (SafeSz (coerce (size v) - d)) v {-# INLINE unsafeDrop #-} @@ -139,7 +139,7 @@ unsafeDrop (Sz d) v = unsafeLinearSlice d (SafeSz (coerce (size v) - d)) v -- -- @since 0.5.1 unsafeFromListN :: Sz1 -> [e] -> Vector DS e -unsafeFromListN (Sz n) = fromSteps . S.unsafeFromListN n +unsafeFromListN n = fromSteps . S.unsafeFromListN n {-# INLINE unsafeFromListN #-} -- | /O(n)/ - Right unfolding function with at most @n@ number of elements. @@ -158,7 +158,7 @@ unsafeUnfoldrN :: -- is reached. -> s -- ^ Inititial element. -> Vector DS e -unsafeUnfoldrN (Sz n) f = DSArray . S.unsafeUnfoldrN n f +unsafeUnfoldrN n f = DSArray . S.unsafeUnfoldrN n f {-# INLINE unsafeUnfoldrN #-} @@ -172,5 +172,5 @@ unsafeUnfoldrN (Sz n) f = DSArray . S.unsafeUnfoldrN n f -- -- @since 0.5.1 unsafeUnfoldrNM :: Monad m => Sz1 -> (s -> m (Maybe (e, s))) -> s -> m (Vector DS e) -unsafeUnfoldrNM (Sz n) f = fromStepsM . S.unsafeUnfoldrNM n f +unsafeUnfoldrNM n f = fromStepsM . S.unsafeUnfoldrNM n f {-# INLINE unsafeUnfoldrNM #-} From a4622e7cb721c909fc870ddd0ae97be5be0fb6ad Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Thu, 10 Dec 2020 06:37:20 +0300 Subject: [PATCH 07/65] Improve slicing by removing overlapping --- .../src/Data/Massiv/Array/Manifest/Boxed.hs | 77 +++------- .../Data/Massiv/Array/Manifest/Internal.hs | 140 +++++++++++++++--- .../Data/Massiv/Array/Manifest/Primitive.hs | 45 +----- .../Data/Massiv/Array/Manifest/Storable.hs | 28 +--- .../src/Data/Massiv/Array/Manifest/Unboxed.hs | 72 +++------ massiv/src/Data/Massiv/Core/Index.hs | 1 + massiv/src/Data/Massiv/Core/Index/Ix.hs | 2 +- massiv/src/Data/Massiv/Core/List.hs | 22 +-- 8 files changed, 179 insertions(+), 208 deletions(-) diff --git a/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs b/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs index a451477a..8021fba3 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs @@ -163,28 +163,18 @@ instance Index ix => Extract BL ix e where {-# INLINE unsafeExtract #-} -instance ( Index ix - , Index (Lower ix) - , Elt M ix e ~ Array M (Lower ix) e - , Elt BL ix e ~ Array M (Lower ix) e - ) => - OuterSlice BL ix e where - unsafeOuterSlice arr = unsafeOuterSlice (toManifest arr) +instance (Elt BL ix e ~ Elt M ix e, Slice M ix e) => Slice BL ix e where + unsafeSlice = unsafeSlice . toManifest + {-# INLINE unsafeSlice #-} + +instance (Elt BL ix e ~ Elt M ix e, OuterSlice M ix e) => OuterSlice BL ix e where + unsafeOuterSlice = unsafeOuterSlice . toManifest {-# INLINE unsafeOuterSlice #-} -instance ( Index ix - , Index (Lower ix) - , Elt M ix e ~ Array M (Lower ix) e - , Elt BL ix e ~ Array M (Lower ix) e - ) => - InnerSlice BL ix e where - unsafeInnerSlice arr = unsafeInnerSlice (toManifest arr) +instance (Elt BL ix e ~ Elt M ix e, InnerSlice M ix e) => InnerSlice BL ix e where + unsafeInnerSlice = unsafeInnerSlice . toManifest {-# INLINE unsafeInnerSlice #-} -instance {-# OVERLAPPING #-} Slice BL Ix1 e where - unsafeSlice arr i _ _ = pure (unsafeLinearIndex arr i) - {-# INLINE unsafeSlice #-} - instance Manifest BL e where @@ -374,28 +364,18 @@ instance Index ix => Extract B ix e where {-# INLINE unsafeExtract #-} -instance ( Index ix - , Index (Lower ix) - , Elt M ix e ~ Array M (Lower ix) e - , Elt B ix e ~ Array M (Lower ix) e - ) => - OuterSlice B ix e where - unsafeOuterSlice arr = unsafeOuterSlice (toManifest arr) +instance (Elt B ix e ~ Elt M ix e, Slice M ix e) => Slice B ix e where + unsafeSlice = unsafeSlice . toManifest + {-# INLINE unsafeSlice #-} + +instance (Elt B ix e ~ Elt M ix e, OuterSlice M ix e) => OuterSlice B ix e where + unsafeOuterSlice = unsafeOuterSlice . toManifest {-# INLINE unsafeOuterSlice #-} -instance ( Index ix - , Index (Lower ix) - , Elt M ix e ~ Array M (Lower ix) e - , Elt B ix e ~ Array M (Lower ix) e - ) => - InnerSlice B ix e where - unsafeInnerSlice arr = unsafeInnerSlice (toManifest arr) +instance (Elt B ix e ~ Elt M ix e, InnerSlice M ix e) => InnerSlice B ix e where + unsafeInnerSlice = unsafeInnerSlice . toManifest {-# INLINE unsafeInnerSlice #-} -instance {-# OVERLAPPING #-} Slice B Ix1 e where - unsafeSlice arr i _ _ = pure (unsafeLinearIndex arr i) - {-# INLINE unsafeSlice #-} - instance Manifest B e where @@ -576,31 +556,18 @@ instance (Index ix, NFData e) => Extract BN ix e where {-# INLINE unsafeExtract #-} -instance ( NFData e - , Index ix - , Index (Lower ix) - , Elt M ix e ~ Array M (Lower ix) e - , Elt BN ix e ~ Array M (Lower ix) e - ) => - OuterSlice BN ix e where +instance (NFData e, Elt BN ix e ~ Elt M ix e, Slice M ix e) => Slice BN ix e where + unsafeSlice = unsafeSlice . toManifest + {-# INLINE unsafeSlice #-} + +instance (NFData e, Elt BN ix e ~ Elt M ix e, OuterSlice M ix e) => OuterSlice BN ix e where unsafeOuterSlice = unsafeOuterSlice . toManifest {-# INLINE unsafeOuterSlice #-} -instance ( NFData e - , Index ix - , Index (Lower ix) - , Elt M ix e ~ Array M (Lower ix) e - , Elt BN ix e ~ Array M (Lower ix) e - ) => - InnerSlice BN ix e where +instance (NFData e, Elt BN ix e ~ Elt M ix e, InnerSlice M ix e) => InnerSlice BN ix e where unsafeInnerSlice = unsafeInnerSlice . toManifest {-# INLINE unsafeInnerSlice #-} -instance {-# OVERLAPPING #-} NFData e => Slice BN Ix1 e where - unsafeSlice arr i _ _ = pure (unsafeLinearIndex arr i) - {-# INLINE unsafeSlice #-} - - instance NFData e => Manifest BN e where unsafeLinearIndexM arr = unsafeLinearIndexM (coerce arr) {-# INLINE unsafeLinearIndexM #-} diff --git a/massiv/src/Data/Massiv/Array/Manifest/Internal.hs b/massiv/src/Data/Massiv/Array/Manifest/Internal.hs index 03620665..b8757371 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Internal.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Internal.hs @@ -42,6 +42,9 @@ module Data.Massiv.Array.Manifest.Internal , sizeofMutableArray , iterateUntil , iterateUntilM + , unsafeSliceN + , unsafeOuterSliceN + , unsafeInnerSliceN ) where import Control.Exception (try) @@ -165,43 +168,138 @@ instance Index ix => Extract M ix e where {-# INLINE unsafeExtract #-} +unsafeSliceN :: + (MonadThrow m, Resize (R r), Extract r ix e, Index (Lower ix)) + => Array r ix e + -> ix + -> Sz ix + -> Dim + -> m (Array (R r) (Lower ix) e) +unsafeSliceN arr start cutSz dim = do + (_, newSz) <- pullOutSzM cutSz dim + return $ unsafeResize newSz (unsafeExtract start cutSz arr) +{-# INLINE unsafeSliceN #-} -instance {-# OVERLAPPING #-} Slice M Ix1 e where +instance Slice M Ix1 e where unsafeSlice arr i _ _ = pure (unsafeLinearIndex arr i) {-# INLINE unsafeSlice #-} -instance ( Index ix - , Index (Lower ix) - , Elt M ix e ~ Array M (Lower ix) e - ) => - Slice M ix e where - unsafeSlice arr start cutSz dim = do - (_, newSz) <- pullOutSzM cutSz dim - return $ unsafeResize newSz (unsafeExtract start cutSz arr) +instance Slice M Ix2 e where + unsafeSlice = unsafeSliceN {-# INLINE unsafeSlice #-} -instance {-# OVERLAPPING #-} OuterSlice M Ix1 e where +instance {-# OVERLAPPING #-} Slice M Ix3 e where + unsafeSlice = unsafeSliceN + {-# INLINE unsafeSlice #-} + +instance HighIxN n => Slice M (IxN n) e where + unsafeSlice = unsafeSliceN + {-# INLINE unsafeSlice #-} + +instance Slice M Ix2T e where + unsafeSlice = unsafeSliceN + {-# INLINE unsafeSlice #-} + +instance Slice M Ix3T e where + unsafeSlice = unsafeSliceN + {-# INLINE unsafeSlice #-} + +instance Slice M Ix4T e where + unsafeSlice = unsafeSliceN + {-# INLINE unsafeSlice #-} + +instance Slice M Ix5T e where + unsafeSlice = unsafeSliceN + {-# INLINE unsafeSlice #-} + + +unsafeOuterSliceN :: + forall r ix e. (Source r e, Index ix, Index (Lower ix)) + => Array r ix e + -> Int + -> Array M (Lower ix) e +unsafeOuterSliceN !arr !i = + MArray (getComp arr) (snd (unconsSz (size arr))) (unsafeLinearIndex arr . (+ kStart)) + where + !kStart = toLinearIndex (size arr) (consDim i (zeroIndex :: Lower ix)) +{-# INLINE unsafeOuterSliceN #-} + +instance OuterSlice M Ix1 e where unsafeOuterSlice !arr = unsafeIndex arr {-# INLINE unsafeOuterSlice #-} -instance (Elt M ix e ~ Array M (Lower ix) e, Index ix, Index (Lower ix)) => OuterSlice M ix e where - unsafeOuterSlice !arr !i = - MArray (getComp arr) (snd (unconsSz (size arr))) (unsafeLinearIndex arr . (+ kStart)) - where - !kStart = toLinearIndex (size arr) (consDim i (zeroIndex :: Lower ix)) +instance OuterSlice M Ix2 e where + unsafeOuterSlice = unsafeOuterSliceN + {-# INLINE unsafeOuterSlice #-} + +instance {-# OVERLAPPING #-} OuterSlice M Ix3 e where + unsafeOuterSlice = unsafeOuterSliceN + {-# INLINE unsafeOuterSlice #-} + +instance HighIxN n => OuterSlice M (IxN n) e where + unsafeOuterSlice = unsafeOuterSliceN + {-# INLINE unsafeOuterSlice #-} + +instance OuterSlice M Ix2T e where + unsafeOuterSlice = unsafeOuterSliceN {-# INLINE unsafeOuterSlice #-} -instance {-# OVERLAPPING #-} InnerSlice M Ix1 e where +instance OuterSlice M Ix3T e where + unsafeOuterSlice = unsafeOuterSliceN + {-# INLINE unsafeOuterSlice #-} + +instance OuterSlice M Ix4T e where + unsafeOuterSlice = unsafeOuterSliceN + {-# INLINE unsafeOuterSlice #-} + +instance OuterSlice M Ix5T e where + unsafeOuterSlice = unsafeOuterSliceN + {-# INLINE unsafeOuterSlice #-} + + +instance InnerSlice M Ix1 e where unsafeInnerSlice !arr _ = unsafeIndex arr {-# INLINE unsafeInnerSlice #-} -instance (Elt M ix e ~ Array M (Lower ix) e, Index ix, Index (Lower ix)) => InnerSlice M ix e where - unsafeInnerSlice !arr (szL, m) !i = - MArray (getComp arr) szL (\k -> unsafeLinearIndex arr (k * unSz m + kStart)) - where - !kStart = toLinearIndex (size arr) (snocDim (zeroIndex :: Lower ix) i) +unsafeInnerSliceN :: + forall r ix e. (Index ix, Index (Lower ix), Source r e) + => Array r ix e + -> (Sz (Lower ix), Sz Int) + -> Int + -> Array M (Lower ix) e +unsafeInnerSliceN !arr (szL, m) !i = + MArray (getComp arr) szL (\k -> unsafeLinearIndex arr (k * unSz m + kStart)) + where + !kStart = toLinearIndex (size arr) (snocDim (zeroIndex :: Lower ix) i) +{-# INLINE unsafeInnerSliceN #-} + +instance InnerSlice M Ix2 e where + unsafeInnerSlice = unsafeInnerSliceN {-# INLINE unsafeInnerSlice #-} +instance {-# OVERLAPPING #-} InnerSlice M Ix3 e where + unsafeInnerSlice = unsafeInnerSliceN + {-# INLINE unsafeInnerSlice #-} + +instance HighIxN n => InnerSlice M (IxN n) e where + unsafeInnerSlice = unsafeInnerSliceN + {-# INLINE unsafeInnerSlice #-} + +instance InnerSlice M Ix2T e where + unsafeInnerSlice = unsafeInnerSliceN + {-# INLINE unsafeInnerSlice #-} + +instance InnerSlice M Ix3T e where + unsafeInnerSlice = unsafeInnerSliceN + {-# INLINE unsafeInnerSlice #-} + +instance InnerSlice M Ix4T e where + unsafeInnerSlice = unsafeInnerSliceN + {-# INLINE unsafeInnerSlice #-} + +instance InnerSlice M Ix5T e where + unsafeInnerSlice = unsafeInnerSliceN + {-# INLINE unsafeInnerSlice #-} instance Index ix => Load M ix e where loadArrayM scheduler (MArray _ sz f) = splitLinearlyWith_ scheduler (totalElem sz) f diff --git a/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs b/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs index d4b4d170..ddfc80cc 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs @@ -141,49 +141,16 @@ instance (Prim e, Index ix) => Extract P ix e where unsafeExtract !sIx !newSz !arr = unsafeExtract sIx newSz (toManifest arr) {-# INLINE unsafeExtract #-} - -instance {-# OVERLAPPING #-} Prim e => Slice P Ix1 e where - unsafeSlice arr i _ _ = pure (unsafeLinearIndex arr i) - {-# INLINE unsafeSlice #-} - - -instance ( Prim e - , Index ix - , Index (Lower ix) - , Elt P ix e ~ Elt M ix e - , Elt M ix e ~ Array M (Lower ix) e - ) => - Slice P ix e where - unsafeSlice arr = unsafeSlice (toManifest arr) +instance (Prim e, Elt P ix e ~ Elt M ix e, Slice M ix e) => Slice P ix e where + unsafeSlice = unsafeSlice . toManifest {-# INLINE unsafeSlice #-} -instance {-# OVERLAPPING #-} Prim e => OuterSlice P Ix1 e where - unsafeOuterSlice = unsafeLinearIndex +instance (Prim e, Elt P ix e ~ Elt M ix e, OuterSlice M ix e) => OuterSlice P ix e where + unsafeOuterSlice = unsafeOuterSlice . toManifest {-# INLINE unsafeOuterSlice #-} -instance ( Prim e - , Index ix - , Index (Lower ix) - , Elt M ix e ~ Array M (Lower ix) e - , Elt P ix e ~ Array M (Lower ix) e - ) => - OuterSlice P ix e where - unsafeOuterSlice arr = unsafeOuterSlice (toManifest arr) - {-# INLINE unsafeOuterSlice #-} - - -instance {-# OVERLAPPING #-} Prim e => InnerSlice P Ix1 e where - unsafeInnerSlice arr _ = unsafeLinearIndex arr - {-# INLINE unsafeInnerSlice #-} - -instance ( Prim e - , Index ix - , Index (Lower ix) - , Elt M ix e ~ Array M (Lower ix) e - , Elt P ix e ~ Array M (Lower ix) e - ) => - InnerSlice P ix e where - unsafeInnerSlice arr = unsafeInnerSlice (toManifest arr) +instance (Prim e, Elt P ix e ~ Elt M ix e, InnerSlice M ix e) => InnerSlice P ix e where + unsafeInnerSlice = unsafeInnerSlice . toManifest {-# INLINE unsafeInnerSlice #-} instance Prim e => Manifest P e where diff --git a/massiv/src/Data/Massiv/Array/Manifest/Storable.hs b/massiv/src/Data/Massiv/Array/Manifest/Storable.hs index f24475f8..65c966dd 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Storable.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Storable.hs @@ -129,30 +129,18 @@ instance (Storable e, Index ix) => Extract S ix e where -instance ( Storable e - , Index ix - , Index (Lower ix) - , Elt M ix e ~ Array M (Lower ix) e - , Elt S ix e ~ Array M (Lower ix) e - ) => - OuterSlice S ix e where - unsafeOuterSlice arr = unsafeOuterSlice (toManifest arr) +instance (Storable e, Elt S ix e ~ Elt M ix e, Slice M ix e) => Slice S ix e where + unsafeSlice = unsafeSlice . toManifest + {-# INLINE unsafeSlice #-} + +instance (Storable e, Elt S ix e ~ Elt M ix e, OuterSlice M ix e) => OuterSlice S ix e where + unsafeOuterSlice = unsafeOuterSlice . toManifest {-# INLINE unsafeOuterSlice #-} -instance ( Storable e - , Index ix - , Index (Lower ix) - , Elt M ix e ~ Array M (Lower ix) e - , Elt S ix e ~ Array M (Lower ix) e - ) => - InnerSlice S ix e where - unsafeInnerSlice arr = unsafeInnerSlice (toManifest arr) +instance (Storable e, Elt S ix e ~ Elt M ix e, InnerSlice M ix e) => InnerSlice S ix e where + unsafeInnerSlice = unsafeInnerSlice . toManifest {-# INLINE unsafeInnerSlice #-} -instance {-# OVERLAPPING #-} Storable e => Slice S Ix1 e where - unsafeSlice arr i _ _ = pure (unsafeLinearIndex arr i) - {-# INLINE unsafeSlice #-} - instance Storable e => Manifest S e where diff --git a/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs b/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs index 12456462..63d65add 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs @@ -16,7 +16,7 @@ -- module Data.Massiv.Array.Manifest.Unboxed ( U (..) - , VU.Unbox + , Unbox , Array(..) , toUnboxedVector , toUnboxedMVector @@ -33,6 +33,7 @@ import Data.Massiv.Array.Mutable import Data.Massiv.Core.Common import Data.Massiv.Core.List import Data.Massiv.Core.Operations +import Data.Vector.Unboxed (Unbox) import qualified Data.Vector.Generic.Mutable as VGM import qualified Data.Vector.Unboxed as VU import qualified Data.Vector.Unboxed.Mutable as MVU @@ -50,7 +51,7 @@ data instance Array U ix e = UArray { uComp :: !Comp , uData :: !(VU.Vector e) } -instance (Ragged L ix e, Show e, VU.Unbox e) => Show (Array U ix e) where +instance (Ragged L ix e, Show e, Unbox e) => Show (Array U ix e) where showsPrec = showsArrayPrec id showList = showArrayList @@ -76,16 +77,16 @@ instance (VU.Unbox e, Index ix) => Construct U ix e where {-# INLINE replicate #-} -instance (VU.Unbox e, Eq e, Index ix) => Eq (Array U ix e) where +instance (Unbox e, Eq e, Index ix) => Eq (Array U ix e) where (==) = eqArrays (==) {-# INLINE (==) #-} -instance (VU.Unbox e, Ord e, Index ix) => Ord (Array U ix e) where +instance (Unbox e, Ord e, Index ix) => Ord (Array U ix e) where compare = compareArrays compare {-# INLINE compare #-} -instance VU.Unbox e => Source U e where +instance Unbox e => Source U e where unsafeLinearIndex (UArray _ _ v) = INDEX_CHECK("(Source U ix e).unsafeLinearIndex", Sz . VU.length, VU.unsafeIndex) v {-# INLINE unsafeLinearIndex #-} @@ -104,70 +105,39 @@ instance Resize U where unsafeResize !sz !arr = arr { uSize = sz } {-# INLINE unsafeResize #-} -instance (VU.Unbox e, Index ix) => Extract U ix e where +instance (Unbox e, Index ix) => Extract U ix e where unsafeExtract !sIx !newSz !arr = unsafeExtract sIx newSz (toManifest arr) {-# INLINE unsafeExtract #-} -instance (VU.Unbox e, Index ix) => Load U ix e where +instance (Unbox e, Index ix) => Load U ix e where type R U = M loadArrayM !scheduler !arr = splitLinearlyWith_ scheduler (elemsCount arr) (unsafeLinearIndex arr) {-# INLINE loadArrayM #-} -instance (VU.Unbox e, Index ix) => StrideLoad U ix e +instance (Unbox e, Index ix) => StrideLoad U ix e -instance {-# OVERLAPPING #-} VU.Unbox e => Slice U Ix1 e where - unsafeSlice arr i _ _ = pure (unsafeLinearIndex arr i) +instance (Unbox e, Elt U ix e ~ Elt M ix e, Slice M ix e) => Slice U ix e where + unsafeSlice = unsafeSlice . toManifest {-# INLINE unsafeSlice #-} - -instance ( VU.Unbox e - , Index ix - , Index (Lower ix) - , Elt U ix e ~ Elt M ix e - , Elt M ix e ~ Array M (Lower ix) e - ) => - Slice U ix e where - unsafeSlice arr = unsafeSlice (toManifest arr) - {-# INLINE unsafeSlice #-} - - -instance {-# OVERLAPPING #-} VU.Unbox e => OuterSlice U Ix1 e where - unsafeOuterSlice = unsafeLinearIndex +instance (Unbox e, Elt U ix e ~ Elt M ix e, OuterSlice M ix e) => OuterSlice U ix e where + unsafeOuterSlice = unsafeOuterSlice . toManifest {-# INLINE unsafeOuterSlice #-} -instance ( VU.Unbox e - , Index ix - , Index (Lower ix) - , Elt U ix e ~ Elt M ix e - , Elt M ix e ~ Array M (Lower ix) e - ) => - OuterSlice U ix e where - unsafeOuterSlice arr = unsafeOuterSlice (toManifest arr) - {-# INLINE unsafeOuterSlice #-} - -instance {-# OVERLAPPING #-} VU.Unbox e => InnerSlice U Ix1 e where - unsafeInnerSlice arr _ = unsafeLinearIndex arr +instance (Unbox e, Elt U ix e ~ Elt M ix e, InnerSlice M ix e) => InnerSlice U ix e where + unsafeInnerSlice = unsafeInnerSlice . toManifest {-# INLINE unsafeInnerSlice #-} -instance ( VU.Unbox e - , Index ix - , Index (Lower ix) - , Elt U ix e ~ Elt M ix e - , Elt M ix e ~ Array M (Lower ix) e - ) => - InnerSlice U ix e where - unsafeInnerSlice arr = unsafeInnerSlice (toManifest arr) - {-# INLINE unsafeInnerSlice #-} -instance VU.Unbox e => Manifest U e where +instance Unbox e => Manifest U e where unsafeLinearIndexM (UArray _ _ v) = INDEX_CHECK("(Manifest U ix e).unsafeLinearIndexM", Sz . VU.length, VU.unsafeIndex) v {-# INLINE unsafeLinearIndexM #-} -instance VU.Unbox e => Mutable U e where +instance Unbox e => Mutable U e where data MArray s U ix e = MUArray !(Sz ix) !(VU.MVector s e) msize (MUArray sz _) = sz @@ -204,14 +174,14 @@ instance VU.Unbox e => Mutable U e where {-# INLINE unsafeLinearGrow #-} -instance (Index ix, VU.Unbox e) => Stream U ix e where +instance (Index ix, Unbox e) => Stream U ix e where toStream = S.steps {-# INLINE toStream #-} toStreamIx = S.isteps {-# INLINE toStreamIx #-} -instance ( VU.Unbox e +instance ( Unbox e , IsList (Array L ix e) , Nested LN ix e , Nested L ix e @@ -260,7 +230,7 @@ toUnboxedMVector (MUArray _ mv) = mv -- | /O(1)/ - Wrap an unboxed vector and produce an unboxed flat array. -- -- @since 0.6.0 -fromUnboxedVector :: VU.Unbox e => Comp -> VU.Vector e -> Array U Ix1 e +fromUnboxedVector :: VU.Unbox e => Comp -> VU.Vector e -> Vector U e fromUnboxedVector comp v = UArray comp (SafeSz (VU.length v)) v {-# INLINE fromUnboxedVector #-} @@ -268,6 +238,6 @@ fromUnboxedVector comp v = UArray comp (SafeSz (VU.length v)) v -- | /O(1)/ - Wrap an unboxed mutable vector and produce a mutable unboxed flat array. -- -- @since 0.5.0 -fromUnboxedMVector :: VU.Unbox e => VU.MVector s e -> MArray s U Ix1 e +fromUnboxedMVector :: Unbox e => VU.MVector s e -> MVector s U e fromUnboxedMVector mv = MUArray (SafeSz (MVU.length mv)) mv {-# INLINE fromUnboxedMVector #-} diff --git a/massiv/src/Data/Massiv/Core/Index.hs b/massiv/src/Data/Massiv/Core/Index.hs index 7ba70588..b88249a1 100644 --- a/massiv/src/Data/Massiv/Core/Index.hs +++ b/massiv/src/Data/Massiv/Core/Index.hs @@ -17,6 +17,7 @@ module Data.Massiv.Core.Index , pattern Ix1 , type Ix2(Ix2, (:.)) , IxN((:>), Ix3, Ix4, Ix5) + , HighIxN , type Ix3 , type Ix4 , type Ix5 diff --git a/massiv/src/Data/Massiv/Core/Index/Ix.hs b/massiv/src/Data/Massiv/Core/Index/Ix.hs index e7b58cf1..9debfab5 100644 --- a/massiv/src/Data/Massiv/Core/Index/Ix.hs +++ b/massiv/src/Data/Massiv/Core/Index/Ix.hs @@ -376,7 +376,7 @@ instance {-# OVERLAPPING #-} Index (IxN 3) where -- -- @since 0.6.0 type HighIxN n - = (4 <= n, KnownNat n, KnownNat (n - 1), Index (Ix (n - 1)), IxN (n - 1) ~ Ix (n - 1)) + = (4 <= n, KnownNat n, KnownNat (n - 1), Index (IxN (n - 1)), IxN (n - 1) ~ Ix (n - 1)) instance {-# OVERLAPPABLE #-} HighIxN n => Index (IxN n) where type Dimensions (IxN n) = n diff --git a/massiv/src/Data/Massiv/Core/List.hs b/massiv/src/Data/Massiv/Core/List.hs index bf3e32a9..d6fbf0c6 100644 --- a/massiv/src/Data/Massiv/Core/List.hs +++ b/massiv/src/Data/Massiv/Core/List.hs @@ -163,19 +163,6 @@ instance Shape L Ix2 where outerSize = outerSize . lData {-# INLINE outerSize #-} --- instance Shape LN Ix3 where --- linearSize = SafeSz . getSum . foldMap (Sum . unSz . linearSize) . unList --- {-# INLINE linearSize #-} --- linearSizeHint = lengthHintList . unList --- {-# INLINE linearSizeHint #-} --- isEmpty = null . unList --- {-# INLINE isEmpty #-} --- outerSize arr = --- case unList arr of --- [] -> zeroSz --- (x:xs) -> SafeSz ((1 + length xs) :> unSz (outerSize x)) --- {-# INLINE outerSize #-} - instance (Shape LN (Ix (n - 1)), Index (IxN n)) => Shape LN (IxN n) where linearSize = SafeSz . getSum . foldMap (Sum . unSz . linearSize) . unList {-# INLINE linearSize #-} @@ -291,14 +278,7 @@ instance Ragged L Ix2 e where showN (\s y -> raggedFormat f s (LArray comp y :: Array L Ix1 e)) sep (coerce xs) --- Ragged L (Lower ix) e --- , Elt L ix e ~ Array L (Lower ix) e --- , Elt LN ix e ~ Array LN (Lower ix) e --- , -instance ( Shape L (IxN n) - , Shape LN (Ix (n - 1)) - , Ragged L (Ix (n - 1)) e - ) => +instance (Shape L (IxN n), Shape LN (Ix (n - 1)), Ragged L (Ix (n - 1)) e) => Ragged L (IxN n) e where emptyR comp = LArray comp (List []) {-# INLINE emptyR #-} From 67ab9df3fb7bd5cc6a0d01c449ff7e18a3d50475 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sun, 13 Dec 2020 14:38:06 +0300 Subject: [PATCH 08/65] Switch to major version bump of 1.0 --- massiv/src/Data/Massiv/Array/Ops/Fold/Internal.hs | 2 +- massiv/src/Data/Massiv/Core/Common.hs | 10 +++++----- massiv/src/Data/Massiv/Core/Index/Ix.hs | 2 +- 3 files changed, 7 insertions(+), 7 deletions(-) diff --git a/massiv/src/Data/Massiv/Array/Ops/Fold/Internal.hs b/massiv/src/Data/Massiv/Array/Ops/Fold/Internal.hs index 6388eef3..3cfe11ab 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Fold/Internal.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Fold/Internal.hs @@ -339,7 +339,7 @@ ifoldlIO f !initAcc g !tAcc !arr -- them. Number of chunks will depend on the computation strategy. Results of each action -- will be combined with a folding function. -- --- @since 0.6.0 +-- @since 1.0.0 splitReduce :: (MonadUnliftIO m, Index ix, Source r e) => (Scheduler m a -> Vector r e -> m a) diff --git a/massiv/src/Data/Massiv/Core/Common.hs b/massiv/src/Data/Massiv/Core/Common.hs index 11d4119d..88037463 100644 --- a/massiv/src/Data/Massiv/Core/Common.hs +++ b/massiv/src/Data/Massiv/Core/Common.hs @@ -248,7 +248,7 @@ class Load r ix e => Construct r ix e where -- | Size hint -- --- @since 0.6.0 +-- @since 1.0.0 data LengthHint = LengthExact Sz1 -- ^ Exact known size | LengthMax Sz1 -- ^ Upper bound on the size @@ -258,12 +258,12 @@ data LengthHint -- | A shape of an array. -- --- @since 0.6.0 +-- @since 1.0.0 class Index ix => Shape r ix where -- | /O(1)/ - Check what do we know about the number of elements without doing any work -- - -- @since 0.6.0 + -- @since 1.0.0 linearSizeHint :: Array r ix e -> LengthHint default linearSizeHint :: Size r => Array r ix e -> LengthHint linearSizeHint = LengthExact . SafeSz . elemsCount @@ -280,7 +280,7 @@ class Index ix => Shape r ix where -- | /O(n)/ - Rectangular size of an array that is inferred from looking at the first row in -- each dimensions. For rectangular arrays this is the same as `size` -- - -- @since 0.6.0 + -- @since 1.0.0 outerSize :: Array r ix e -> Sz ix default outerSize :: Size r => Array r ix e -> Sz ix outerSize = size @@ -291,7 +291,7 @@ class Index ix => Shape r ix where -- will be used as the initial size of the mutable array into which the loading will -- happen. -- - -- @since 0.6.0 + -- @since 1.0.0 maxLinearSize :: Array r ix e -> Maybe Sz1 maxLinearSize = lengthHintUpperBound . linearSizeHint {-# INLINE maxLinearSize #-} diff --git a/massiv/src/Data/Massiv/Core/Index/Ix.hs b/massiv/src/Data/Massiv/Core/Index/Ix.hs index 9debfab5..b928154a 100644 --- a/massiv/src/Data/Massiv/Core/Index/Ix.hs +++ b/massiv/src/Data/Massiv/Core/Index/Ix.hs @@ -374,7 +374,7 @@ instance {-# OVERLAPPING #-} Index (IxN 3) where -- | Constraint synonym that encapsulates all constraints needed for dimension 4 and higher. -- --- @since 0.6.0 +-- @since 1.0.0 type HighIxN n = (4 <= n, KnownNat n, KnownNat (n - 1), Index (IxN (n - 1)), IxN (n - 1) ~ Ix (n - 1)) From e68c410f4bc412841dbae6de6fecfdff3374bcae Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sat, 16 Jan 2021 04:33:22 +0300 Subject: [PATCH 09/65] Fix compilation after rebase on v0.6 --- massiv-test/tests/Test/Massiv/Array/StencilSpec.hs | 6 +----- massiv/src/Data/Massiv/Array/Manifest/Boxed.hs | 1 - 2 files changed, 1 insertion(+), 6 deletions(-) diff --git a/massiv-test/tests/Test/Massiv/Array/StencilSpec.hs b/massiv-test/tests/Test/Massiv/Array/StencilSpec.hs index 5b793b6b..2d038db1 100644 --- a/massiv-test/tests/Test/Massiv/Array/StencilSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/StencilSpec.hs @@ -32,11 +32,7 @@ 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 + (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 diff --git a/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs b/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs index 8021fba3..9cb185a7 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs @@ -162,7 +162,6 @@ instance Index ix => Extract BL ix e where unsafeExtract !sIx !newSz !arr = unsafeExtract sIx newSz (toManifest arr) {-# INLINE unsafeExtract #-} - instance (Elt BL ix e ~ Elt M ix e, Slice M ix e) => Slice BL ix e where unsafeSlice = unsafeSlice . toManifest {-# INLINE unsafeSlice #-} From 270f4b1b102851ffd770c140394b56fff30aa7c6 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Tue, 13 Apr 2021 17:14:54 +0300 Subject: [PATCH 10/65] Export withMassivScheduler_ and fix withLoadMArray loading --- massiv/src/Data/Massiv/Array/Mutable.hs | 29 +++++++++++-------------- massiv/src/Data/Massiv/Core.hs | 1 + massiv/src/Data/Massiv/Core/Common.hs | 8 +++++-- 3 files changed, 20 insertions(+), 18 deletions(-) diff --git a/massiv/src/Data/Massiv/Array/Mutable.hs b/massiv/src/Data/Massiv/Array/Mutable.hs index bdbc6a7d..b1c0f3a5 100644 --- a/massiv/src/Data/Massiv/Array/Mutable.hs +++ b/massiv/src/Data/Massiv/Array/Mutable.hs @@ -858,16 +858,14 @@ withMArray_ arr action = do -- array. For that reason it will be faster if supplied array is delayed. -- -- @since 0.6.1 -withLoadMArray_ :: --TODO: fix unsafeLoadIntoM to accept a scheduler - forall r ix e r' m b. (Size r', Load r' ix e, Mutable r e, MonadUnliftIO m) +withLoadMArray_ :: + forall r ix e r' m b. (Load r' ix e, Mutable r e, MonadUnliftIO m) => Array r' ix e -> (Scheduler m () -> MArray RealWorld r ix e -> m b) -> m (Array r ix e) withLoadMArray_ arr action = do - marr <- liftIO $ unsafeNew (size arr) - withScheduler_ (getComp arr) $ \scheduler -> do - runBatch_ scheduler $ \_ -> loadArrayM scheduler arr (\i -> liftIO . unsafeLinearWrite marr i) - action scheduler marr + marr <- loadArray arr + withScheduler_ (getComp arr) (`action` marr) liftIO $ unsafeFreeze (getComp arr) marr {-# INLINE[2] withLoadMArray_ #-} {-# RULES @@ -908,14 +906,13 @@ withMArrayS_ arr action = snd <$> withMArrayS arr action -- | Same as `withMArrayS`, but will work with any loadable array. -- -- @since 0.6.1 -withLoadMArrayS :: --TODO: fix unsafeLoadIntoM to accept a scheduler - forall r ix e r' m a. (Size r', Load r' ix e, Mutable r e, PrimMonad m) +withLoadMArrayS :: + forall r ix e r' m a. (Load r' ix e, Mutable r e, PrimMonad m) => Array r' ix e -> (MArray (PrimState m) r ix e -> m a) -> m (a, Array r ix e) withLoadMArrayS arr action = do - marr <- unsafeNew (size arr) - loadArrayM trivialScheduler_ arr (unsafeLinearWrite marr) + marr <- loadArrayS arr a <- action marr (,) a <$> unsafeFreeze (getComp arr) marr {-# INLINE[2] withLoadMArrayS #-} @@ -923,8 +920,8 @@ withLoadMArrayS arr action = do -- | Same as `withMArrayS_`, but will work with any loadable array. -- -- @since 0.6.1 -withLoadMArrayS_ :: --TODO: remove Size - forall r ix e r' m a. (Size r', Load r' ix e, Mutable r e, PrimMonad m) +withLoadMArrayS_ :: + forall r ix e r' m a. (Load r' ix e, Mutable r e, PrimMonad m) => Array r' ix e -> (MArray (PrimState m) r ix e -> m a) -> m (Array r ix e) @@ -957,8 +954,8 @@ withMArrayST_ arr f = runST $ withMArrayS_ arr f -- | Same as `withMArrayST`, but works with any loadable array. -- -- @since 0.6.1 -withLoadMArrayST :: --TODO: remove Size - forall r ix e r' a. (Size r', Load r' ix e, Mutable r e) +withLoadMArrayST :: + forall r ix e r' a. (Load r' ix e, Mutable r e) => Array r' ix e -> (forall s. MArray s r ix e -> ST s a) -> (a, Array r ix e) @@ -968,8 +965,8 @@ withLoadMArrayST arr f = runST $ withLoadMArrayS arr f -- | Same as `withMArrayST_`, but works with any loadable array. -- -- @since 0.6.1 -withLoadMArrayST_ :: --TODO: remove Size - forall r ix e r' a. (Size r', Load r' ix e, Mutable r e) +withLoadMArrayST_ :: + forall r ix e r' a. (Load r' ix e, Mutable r e) => Array r' ix e -> (forall s. MArray s r ix e -> ST s a) -> Array r ix e diff --git a/massiv/src/Data/Massiv/Core.hs b/massiv/src/Data/Massiv/Core.hs index 7140e650..b67a3eb1 100644 --- a/massiv/src/Data/Massiv/Core.hs +++ b/massiv/src/Data/Massiv/Core.hs @@ -37,6 +37,7 @@ module Data.Massiv.Core , appComp , WorkerStates , initWorkerStates + , withMassivScheduler_ , module Data.Massiv.Core.Index -- * Numeric , FoldNumeric diff --git a/massiv/src/Data/Massiv/Core/Common.hs b/massiv/src/Data/Massiv/Core/Common.hs index 88037463..c3f50f26 100644 --- a/massiv/src/Data/Massiv/Core/Common.hs +++ b/massiv/src/Data/Massiv/Core/Common.hs @@ -387,7 +387,7 @@ class (Strategy r, Shape r ix) => Load r ix e where -> m () loadArrayM scheduler arr uWrite = loadArrayWithSetM scheduler arr uWrite $ \offset sz e -> - loopM_ offset (< (offset + unSz sz)) (+1) (\i -> uWrite i e) + loopM_ offset (< (offset + unSz sz)) (+1) (`uWrite` e) {-# INLINE loadArrayM #-} -- | Load an array into memory, just like `loadArrayM`. Except it also accepts a @@ -417,7 +417,8 @@ class (Strategy r, Shape r ix) => Load r ix e where -> Array r ix e -> m (MArray (PrimState m) r' ix e) unsafeLoadIntoS marr arr = - munsafeResize (outerSize arr) marr <$ loadArrayWithSetM trivialScheduler_ arr (unsafeLinearWrite marr) (unsafeLinearSet marr) + munsafeResize (outerSize arr) marr <$ + loadArrayWithSetM trivialScheduler_ arr (unsafeLinearWrite marr) (unsafeLinearSet marr) {-# INLINE unsafeLoadIntoS #-} -- | Same as `unsafeLoadIntoS`, but respecting computation strategy. @@ -435,12 +436,15 @@ class (Strategy r, Shape r ix) => Load r ix e where {-# INLINE unsafeLoadIntoM #-} -- | Selects an optimal scheduler for the supplied strategy, but it works only in `IO` +-- +-- @since 1.0.0 withMassivScheduler_ :: Comp -> (Scheduler IO () -> IO ()) -> IO () withMassivScheduler_ comp f = case comp of Par -> withGlobalScheduler_ globalScheduler f Seq -> f trivialScheduler_ _ -> withScheduler_ comp f +{-# INLINE withMassivScheduler_ #-} class (Size r, Load r ix e) => StrideLoad r ix e where -- | Load an array into memory with stride. Default implementation requires an instance of From 062b791684f6e2d8ff7afd7caa44950453010e21 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Fri, 16 Apr 2021 05:05:27 +0300 Subject: [PATCH 11/65] Finished major slicing refactor --- massiv-test/massiv-test.cabal | 2 +- massiv-test/src/Test/Massiv/Array/Mutable.hs | 6 +- massiv-test/src/Test/Massiv/Array/Numeric.hs | 12 +- massiv-test/src/Test/Massiv/Utils.hs | 4 +- .../tests/Test/Massiv/Array/MutableSpec.hs | 8 +- .../Test/Massiv/Array/Numeric/IntegralSpec.hs | 38 +-- .../tests/Test/Massiv/Array/Ops/FoldSpec.hs | 5 +- .../tests/Test/Massiv/Array/Ops/MapSpec.hs | 2 +- .../tests/Test/Massiv/Array/Ops/SliceSpec.hs | 293 +++++++----------- .../Test/Massiv/Array/Ops/TransformSpec.hs | 30 +- massiv-test/tests/Test/Massiv/ArraySpec.hs | 4 +- massiv-test/tests/Test/Massiv/VectorSpec.hs | 44 +-- massiv/CHANGELOG.md | 1 + massiv/massiv.cabal | 2 +- massiv/src/Data/Massiv/Array.hs | 2 + .../Data/Massiv/Array/Delayed/Interleaved.hs | 4 - massiv/src/Data/Massiv/Array/Delayed/Pull.hs | 52 ++-- .../src/Data/Massiv/Array/Delayed/Stream.hs | 4 +- .../src/Data/Massiv/Array/Manifest/Boxed.hs | 65 +--- .../Data/Massiv/Array/Manifest/Internal.hs | 139 +-------- .../Data/Massiv/Array/Manifest/Primitive.hs | 30 +- .../Data/Massiv/Array/Manifest/Storable.hs | 26 +- .../src/Data/Massiv/Array/Manifest/Unboxed.hs | 25 +- massiv/src/Data/Massiv/Array/Mutable.hs | 2 +- massiv/src/Data/Massiv/Array/Numeric.hs | 4 +- .../src/Data/Massiv/Array/Numeric/Integral.hs | 14 +- massiv/src/Data/Massiv/Array/Ops/Fold.hs | 27 +- .../Data/Massiv/Array/Ops/Fold/Internal.hs | 2 +- massiv/src/Data/Massiv/Array/Ops/Slice.hs | 115 +++---- massiv/src/Data/Massiv/Array/Ops/Transform.hs | 94 +++--- massiv/src/Data/Massiv/Array/Unsafe.hs | 2 +- massiv/src/Data/Massiv/Core.hs | 6 +- massiv/src/Data/Massiv/Core/Common.hs | 98 +++--- massiv/src/Data/Massiv/Core/List.hs | 34 +- massiv/src/Data/Massiv/Vector.hs | 35 +-- 35 files changed, 447 insertions(+), 784 deletions(-) diff --git a/massiv-test/massiv-test.cabal b/massiv-test/massiv-test.cabal index fc0984ff..b83a02ec 100644 --- a/massiv-test/massiv-test.cabal +++ b/massiv-test/massiv-test.cabal @@ -1,5 +1,5 @@ name: massiv-test -version: 0.1.7.0 +version: 1.0.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 diff --git a/massiv-test/src/Test/Massiv/Array/Mutable.hs b/massiv-test/src/Test/Massiv/Array/Mutable.hs index 37717299..ab72f11d 100644 --- a/massiv-test/src/Test/Massiv/Array/Mutable.hs +++ b/massiv-test/src/Test/Massiv/Array/Mutable.hs @@ -82,9 +82,8 @@ prop_GrowShrink :: forall r ix e. ( Eq (Array r ix e) , Show (Array r ix e) - , Load (R r) ix e + , Load r ix e , Mutable r e - , Extract r ix e , Construct r ix e , Arbitrary ix , Arbitrary e @@ -185,13 +184,12 @@ mutableSpec :: , Show (Array r ix e) , Show (Array r Ix1 e) , Eq (Array r Ix1 e) - , Load (R r) ix e + , Load r ix e , Eq (Array r ix e) , Typeable e , Show e , Eq e , Mutable r e - , Extract r ix e , Construct r ix e , CoArbitrary ix , Arbitrary e diff --git a/massiv-test/src/Test/Massiv/Array/Numeric.hs b/massiv-test/src/Test/Massiv/Array/Numeric.hs index aa7c0afc..648db654 100644 --- a/massiv-test/src/Test/Massiv/Array/Numeric.hs +++ b/massiv-test/src/Test/Massiv/Array/Numeric.hs @@ -18,7 +18,7 @@ import Test.Massiv.Core.Common () naiveMatrixMatrixMultiply :: - (Num e, Source (R r1) e, Source (R r2) e, OuterSlice r1 Ix2 e, InnerSlice r2 Ix2 e) + (Num e, Source r1 e, Source r2 e) => Array r1 Ix2 e -> Array r2 Ix2 e -> Array D Ix2 e @@ -54,9 +54,8 @@ prop_MatrixMatrixMultiply f arr = expectProp $ do prop_MatrixVectorMultiply :: forall r e. ( Numeric r e - , InnerSlice r Ix2 e , Mutable r e - , Source (R r) e + , Source r e , Construct r Ix1 e , Eq e , Show e @@ -75,9 +74,8 @@ prop_MatrixVectorMultiply f arr = prop_VectorMatrixMultiply :: forall r e. ( Numeric r e - , OuterSlice r Ix2 e , Construct r Ix1 e - , Source (R r) e + , Source r e , Mutable r e , Show (Vector r e) , Eq (Vector r e) @@ -233,9 +231,7 @@ mutableNumericSpec :: , Mutable r e , Construct r Ix1 e , Construct r Ix2 e - , InnerSlice r Ix2 e - , OuterSlice r Ix2 e - , Source (R r) e + , Source r e , Eq e , Show e , Function e diff --git a/massiv-test/src/Test/Massiv/Utils.hs b/massiv-test/src/Test/Massiv/Utils.hs index e76aee6c..b004fc6c 100644 --- a/massiv-test/src/Test/Massiv/Utils.hs +++ b/massiv-test/src/Test/Massiv/Utils.hs @@ -107,13 +107,13 @@ instance Function Word where -- | Convert an hspec Expectation to a quickcheck Property. -- -- @since 1.5.0 -expectProp :: Expectation -> Property +expectProp :: HasCallStack => Expectation -> Property expectProp = monadicIO . run -- | 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 :: (HasCallStack, Testable a) => IO a -> Property propIO action = monadicIO $ run action diff --git a/massiv-test/tests/Test/Massiv/Array/MutableSpec.hs b/massiv-test/tests/Test/Massiv/Array/MutableSpec.hs index 932be094..268e3e85 100644 --- a/massiv-test/tests/Test/Massiv/Array/MutableSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/MutableSpec.hs @@ -2,7 +2,6 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} @@ -25,10 +24,9 @@ type MutableArraySpec r ix e , Function e , Eq (Array r ix e) , Show (Array r ix e) - , Eq (Array (R r) Ix1 e) - , Show (Array (R r) Ix1 e) - , Load (R r) ix e - , Extract r ix e + , Eq (Array r Ix1 e) + , Show (Array r Ix1 e) + , Load r ix e , Resize r , Arbitrary (Array r ix e) , Mutable r e diff --git a/massiv-test/tests/Test/Massiv/Array/Numeric/IntegralSpec.hs b/massiv-test/tests/Test/Massiv/Array/Numeric/IntegralSpec.hs index efd37991..ca4b6e32 100644 --- a/massiv-test/tests/Test/Massiv/Array/Numeric/IntegralSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/Numeric/IntegralSpec.hs @@ -12,26 +12,26 @@ gaussian x = exp (x ^ (2 :: Int)) spec :: Spec spec = do let (a, b) = (0, 2) - integrator rule = rule Seq N (\ s -> gaussian . s) a b (Sz1 1) + integrator rule = rule Seq N (gaussian .) a b (Sz1 1) describe "Integral Approximation" $ do it "Midpoint Rule" $ do - integrator midpointRule 4 ! 0 `shouldBe` 14.485613 - integrator midpointRule 8 ! 0 `shouldBe` 15.905677 - integrator midpointRule 16 ! 0 `shouldBe` 16.311854 - integrator midpointRule 32 ! 0 `shouldBe` 16.417171 - integrator midpointRule 64 ! 0 `shouldBe` 16.443748 - integrator midpointRule 128 ! 0 `shouldBe` 16.450407 + integrator midpointRule 4 `evaluate'` 0 `shouldBe` 14.485613 + integrator midpointRule 8 `evaluate'` 0 `shouldBe` 15.905677 + integrator midpointRule 16 `evaluate'` 0 `shouldBe` 16.311854 + integrator midpointRule 32 `evaluate'` 0 `shouldBe` 16.417171 + integrator midpointRule 64 `evaluate'` 0 `shouldBe` 16.443748 + integrator midpointRule 128 `evaluate'` 0 `shouldBe` 16.450407 it "Trapezoid Rule" $ do - integrator trapezoidRule 4 ! 0 `shouldBe` 20.644558 - integrator trapezoidRule 8 ! 0 `shouldBe` 17.565086 - integrator trapezoidRule 16 ! 0 `shouldBe` 16.735381 - integrator trapezoidRule 32 ! 0 `shouldBe` 16.523618 - integrator trapezoidRule 64 ! 0 `shouldBe` 16.470394 - integrator trapezoidRule 128 ! 0 `shouldBe` 16.457073 + integrator trapezoidRule 4 `evaluate'` 0 `shouldBe` 20.644558 + integrator trapezoidRule 8 `evaluate'` 0 `shouldBe` 17.565086 + integrator trapezoidRule 16 `evaluate'` 0 `shouldBe` 16.735381 + integrator trapezoidRule 32 `evaluate'` 0 `shouldBe` 16.523618 + integrator trapezoidRule 64 `evaluate'` 0 `shouldBe` 16.470394 + integrator trapezoidRule 128 `evaluate'` 0 `shouldBe` 16.457073 it "Simspon's Rule" $ do - integrator simpsonsRule 4 ! 0 `shouldBe` 17.353626 - integrator simpsonsRule 8 ! 0 `shouldBe` 16.538595 - integrator simpsonsRule 16 ! 0 `shouldBe` 16.458815 - integrator simpsonsRule 32 ! 0 `shouldBe` 16.453030 - integrator simpsonsRule 64 ! 0 `shouldBe` 16.452653 - integrator simpsonsRule 128 ! 0 `shouldBe` 16.452629 + integrator simpsonsRule 4 `evaluate'` 0 `shouldBe` 17.353626 + integrator simpsonsRule 8 `evaluate'` 0 `shouldBe` 16.538595 + integrator simpsonsRule 16 `evaluate'` 0 `shouldBe` 16.458815 + integrator simpsonsRule 32 `evaluate'` 0 `shouldBe` 16.453030 + integrator simpsonsRule 64 `evaluate'` 0 `shouldBe` 16.452653 + integrator simpsonsRule 128 `evaluate'` 0 `shouldBe` 16.452629 diff --git a/massiv-test/tests/Test/Massiv/Array/Ops/FoldSpec.hs b/massiv-test/tests/Test/Massiv/Array/Ops/FoldSpec.hs index 42dca719..8e1f9d47 100644 --- a/massiv-test/tests/Test/Massiv/Array/Ops/FoldSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/Ops/FoldSpec.hs @@ -53,10 +53,7 @@ specFold dimStr = prop "foldOps" $ foldOpsProp @ix -prop_foldOuterSliceToList :: - (Elt P ix Int ~ Array M (Lower ix) Int, OuterSlice P ix Int, Index (Lower ix)) - => ArrTiny P ix Int - -> Property +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) diff --git a/massiv-test/tests/Test/Massiv/Array/Ops/MapSpec.hs b/massiv-test/tests/Test/Massiv/Array/Ops/MapSpec.hs index 9fdd2d82..724629a6 100644 --- a/massiv-test/tests/Test/Massiv/Array/Ops/MapSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/Ops/MapSpec.hs @@ -161,7 +161,7 @@ prop_MapWS arr = run $ do let comp = getComp arr count <- getCompWorkers comp - arrStates <- new @P (Sz count) + arrStates <- newMArray' @P (Sz count) states <- initWorkerStates comp (\(WorkerId i) -> pure $ \f -> modifyM_ arrStates f i) arr' <- forWS states arr $ \e smod -> do diff --git a/massiv-test/tests/Test/Massiv/Array/Ops/SliceSpec.hs b/massiv-test/tests/Test/Massiv/Array/Ops/SliceSpec.hs index a2e5813b..e06b3796 100644 --- a/massiv-test/tests/Test/Massiv/Array/Ops/SliceSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/Ops/SliceSpec.hs @@ -1,12 +1,11 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} module Test.Massiv.Array.Ops.SliceSpec (spec) where import Control.Applicative ((<|>)) -import Control.Exception -import Data.Massiv.Array.Unsafe import Data.Massiv.Array as A import Test.Massiv.Core @@ -15,10 +14,7 @@ import Test.Massiv.Core ----------- prop_ExtractEqualsExtractFromTo :: - ( Eq (Array (R r) ix e) - , Show (Array (R r) ix e) - , Extract r ix e - ) + (Source r e, Eq e, Show e, Ragged L ix e) => proxy (r, ix, e) -> SzIx ix -> Array r ix e @@ -28,12 +24,14 @@ prop_ExtractEqualsExtractFromTo _ (SzIx (Sz eIx) sIx) arr = specSizeN :: - ( Eq (Array (R r) ix e) - , Show (Array (R r) ix e) + ( HasCallStack + , Eq e + , Show e + , Ragged L ix e , Arbitrary (Array r ix e) , Show (Array r ix e) + , Source r e , Arbitrary ix - , Extract r ix e ) => proxy (r, ix, e) -> Spec @@ -47,173 +45,116 @@ specSizeN proxy = ----------- -prop_SliceRight :: - (Slice r ix e, OuterSlice r ix e, Eq (Elt r ix e), Show (Elt r ix e)) +prop_SliceOuter :: + ( HasCallStack + , Source r e + , Index ix + , Ragged L (Lower ix) e + , Show e + , Eq e + , Show (Array r (Lower ix) e) + ) => proxy (r, ix, e) - -> Int + -> Ix1 -> Array r ix e -> Property -prop_SliceRight _ i arr = - either (Left . displayException) Right (arr !?> i) === - either (Left . displayException) Right (arr (dimensions (size arr), i)) - - -prop_SliceLeft :: - (Slice r ix e, InnerSlice r ix e, Eq (Elt r ix e), Show (Elt r ix e)) +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 + + +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 -> Property -prop_SliceLeft _ i arr = - either (Left . displayException) Right (arr (1, i)) - - -prop_SliceIndexDim2D :: ArrIx D Ix2 Int -> Property -prop_SliceIndexDim2D (ArrIx arr ix@(i :. j)) = - val === evaluate' (arr i) j - where - val = unsafeIndex arr ix - - -prop_SliceIndexDim2RankD :: ArrIx D Ix2 Int -> Property -prop_SliceIndexDim2RankD (ArrIx arr ix@(i :. j)) = - val === evaluate' (arr (2, i)) j .&&. - val === evaluate' (arr (1, j)) i - where - val = unsafeIndex arr ix - - -prop_SliceIndexDim3D :: ArrIx D Ix3 Int -> Property -prop_SliceIndexDim3D (ArrIx arr ix@(i :> j :. k)) = - val === evaluate' (arr i !> j) k .&&. - val === evaluate' (arr i) j .&&. - val === evaluate' (arr !> i Property -prop_SliceIndexDim3RankD (ArrIx arr ix@(i :> j :. k)) = - val === evaluate' (arr (3, i) (2, j)) k .&&. - val === evaluate' (arr (3, i) (1, k)) j .&&. - val === evaluate' (arr (2, j) (2, i)) k .&&. - val === evaluate' (arr (2, j) (1, k)) i .&&. - val === evaluate' (arr (1, k) (2, i)) j .&&. - val === evaluate' (arr (1, k) (1, j)) i - where - val = unsafeIndex arr ix - - -prop_SliceIndexDim2M :: ArrIx P Ix2 Int -> Property -prop_SliceIndexDim2M (ArrIx arr' ix@(i :. j)) = - val === (arr !> i ! j) .&&. - val === (arr Property -prop_SliceIndexDim2RankM (ArrIx arr' ix@(i :. j)) = - val === (arr (2, i) ! j) .&&. - val === (arr (1, j) ! i) - where - arr = toManifest arr' - val = unsafeIndex arr ix - - -prop_SliceIndexDim3M :: ArrIx P Ix3 Int -> Property -prop_SliceIndexDim3M (ArrIx arr' ix@(i :> j :. k)) = - val === (arr i !> j ! k) .&&. - val === (arr i ! j) .&&. - val === (arr !> i Property -prop_SliceIndexDim3RankM (ArrIx arr' ix@(i :> j :. k)) = - val === (arr (3, i) (2, j) ! k) .&&. - val === (arr (3, i) (1, k) ! j) .&&. - val === (arr (2, j) (2, i) ! k) .&&. - val === (arr (2, j) (1, k) ! i) .&&. - val === (arr (1, k) (2, i) ! j) .&&. - val === (arr (1, k) (1, j) ! i) - where - arr = toManifest arr' - val = unsafeIndex arr ix - - -prop_SliceIndexDim4D :: ArrIx D Ix4 Int -> Property -prop_SliceIndexDim4D (ArrIx arr ix@(i1 :> i2 :> i3 :. i4)) = - val === evaluate' (arr !> i1 !> i2 !> i3) i4 .&&. - val === evaluate' (arr !> i1 !> i2 i1 i1 i2) i3 .&&. - val === evaluate' (arr i1 !> i2) i3 .&&. - val === evaluate' (arr i1 i1) i2 - where - val = unsafeIndex arr ix - -prop_SliceIndexDim4RankD :: ArrIx D Ix4 Int -> Property -prop_SliceIndexDim4RankD (ArrIx arr ix@(i1 :> i2 :> i3 :. i4)) = - val === unsafeIndex (arr (4, i1) (3, i2) (2, i3)) i4 .&&. - val === unsafeIndex (arr (4, i1) (2, i3) (3, i2) (3, i1)) (i3 :. i4) .&&. - val === unsafeIndex (arr (2, i3) (2, i2)) (i1 :. i4) .&&. - val === unsafeIndex (arr (2, i3) (1, i4) !> i1) i2 .&&. - val === unsafeIndex (arr (1, i4) !> i1 !> i2) i3 - where - val = evaluate' arr ix - - -prop_SliceIndexDim4RankM :: ArrIx P Ix4 Int -> Property -prop_SliceIndexDim4RankM (ArrIx arr' ix@(i1 :> i2 :> i3 :. i4)) = - val === (arr (4, i1) (3, i2) (2, i3) ! i4) .&&. - val === (arr (4, i1) (2, i3) (3, i2) (3, i1) ! (i3 :. i4)) .&&. - val === (arr (2, i3) (2, i2) ! (i1 :. i4)) .&&. - val === (arr (2, i3) (1, i4) !> i1 ! i2) .&&. - val === (arr (1, i4) !> i1 !> i2 ! i3) - where - arr = toManifest arr' - val = unsafeIndex arr ix - - -prop_SliceIndexDim4M :: ArrIx P Ix4 Int -> Property -prop_SliceIndexDim4M (ArrIx arr' ix@(i1 :> i2 :> i3 :. i4)) = - val === (arr !> i1 !> i2 !> i3 ! i4) .&&. - val === (arr !> i1 !> i2 i1 i1 i2 ! i3) .&&. - val === (arr i1 !> i2 ! i3) .&&. - val === (arr i1 i1 ! i2) - where - arr = toManifest arr' - val = unsafeIndex arr ix - - - -specSliceN :: ( Arbitrary (Array r ix e) - , Show (Array r ix e) - , Slice r ix e - , OuterSlice r ix e - , InnerSlice r ix e - , Eq (Elt r ix e) - , Show (Elt r ix e) - ) - => proxy (r, ix, e) -> Spec +prop_SliceInner _ i arr = + expectProp $ do + if isSafeIndex (snd (unsnocSz (size arr))) i + then do + e1 <- arr (1, i) + e1 `shouldBe` e2 + else do + arr (1, i) `shouldSatisfy` isNothing + + +prop_SliceIndexDim2 :: (HasCallStack, Source r Int) => ArrIx r Ix2 Int -> Property +prop_SliceIndexDim2 (ArrIx arr ix@(i :. j)) = + expectProp $ do + val <- evaluateM arr ix + evaluateM (arr !> i) j `shouldReturn` val + 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 + val <- evaluateM arr ix + evaluateM (arr i !> j) k `shouldReturn` val + evaluateM (arr i) j `shouldReturn` val + evaluateM (arr !> i (3, i) (2, j)) k `shouldReturn` val + evaluateM (arr (3, i) (1, k)) j `shouldReturn` val + evaluateM (arr (2, j) (2, i)) k `shouldReturn` val + evaluateM (arr (2, j) (1, k)) i `shouldReturn` val + 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) (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 + evaluateM (arr (1, i4) !> i1 !> i2) i3 `shouldReturn` val + + evaluateM (arr !> i1 !> i2 !> i3) i4 `shouldReturn` val + evaluateM (arr !> i1 !> i2 i1 i1 i2) i3 `shouldReturn` val + evaluateM (arr i1 !> i2) i3 `shouldReturn` val + evaluateM (arr i1 i1) i2 `shouldReturn` val + + + + +specSliceN :: + ( HasCallStack + , Source r e + , Construct r ix e + , Arbitrary ix + , Arbitrary e + , Show (Array r ix e) + , Ragged L (Lower ix) e + , Show e + , Eq e + , Show (Array r (Lower ix) e) + ) + => proxy (r, ix, e) + -> Spec specSliceN proxy = describe "Slice" $ do - it "SliceRight" $ property $ prop_SliceRight proxy - it "SliceLeft" $ property $ prop_SliceLeft proxy + prop "SliceOuter" $ prop_SliceOuter proxy + prop "SliceInner" $ prop_SliceInner proxy @@ -225,23 +166,17 @@ spec = do specSizeN (Nothing :: Maybe (D, Ix2, Int)) specSliceN (Nothing :: Maybe (D, Ix2, Int)) describe "SliceIndex" $ do - it "Delayed" $ property prop_SliceIndexDim2D - it "Rank - Delayed" $ property prop_SliceIndexDim2RankD - it "Manifest" $ property prop_SliceIndexDim2M - it "Rank - Manifest" $ property prop_SliceIndexDim2RankM + prop "Delayed" $ prop_SliceIndexDim2 @D + prop "Manifest" $ prop_SliceIndexDim2 @P describe "Ix3" $ do specSizeN (Nothing :: Maybe (D, Ix3, Int)) specSliceN (Nothing :: Maybe (D, Ix3, Int)) describe "SliceIndex" $ do - it "Delayed" $ property prop_SliceIndexDim3D - it "Rank - Delayed" $ property prop_SliceIndexDim3RankD - it "Manifest" $ property prop_SliceIndexDim3M - it "Rank - Manifest" $ property prop_SliceIndexDim3RankM + prop "Delayed" $ prop_SliceIndexDim3 @D + prop "Manifest" $ prop_SliceIndexDim3 @P describe "Ix4" $ do specSizeN (Nothing :: Maybe (D, Ix4, Int)) specSliceN (Nothing :: Maybe (D, Ix4, Int)) describe "SliceIndex" $ do - it "Delayed" $ property prop_SliceIndexDim4D - it "Rank - Delayed" $ property prop_SliceIndexDim4RankD - it "Manifest" $ property prop_SliceIndexDim4M - it "Rank - Manifest" $ property prop_SliceIndexDim4RankM + prop "Delayed" $ prop_SliceIndexDim4 @D + prop "Manifest" $ prop_SliceIndexDim4 @P diff --git a/massiv-test/tests/Test/Massiv/Array/Ops/TransformSpec.hs b/massiv-test/tests/Test/Massiv/Array/Ops/TransformSpec.hs index d86783cc..758aaea0 100644 --- a/massiv-test/tests/Test/Massiv/Array/Ops/TransformSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/Ops/TransformSpec.hs @@ -2,7 +2,6 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} @@ -30,13 +29,7 @@ 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) - , Source (R r) e - , Extract r ix e - , Mutable r e - ) + forall r ix e. (Eq (Array r ix e), Show (Array r ix e), Mutable r e, Index ix) => DimIx ix -> ArrIx r ix e -> Property @@ -45,14 +38,14 @@ prop_ExtractAppend (DimIx dim) (ArrIx arr ix) = prop_SplitExtract :: forall r ix e. - ( Eq (Array r ix e) - , Eq (Array (R r) ix e) + ( Eq e + , Show e + , Eq (Array r ix e) , Show (Array r ix e) - , Show (Array (R r) ix e) - , Source (R r) e - , Load (R r) ix e + , Source r e + , Load r ix e , Mutable r e - , Extract r ix e + , Ragged L ix e ) => DimIx ix -> ArrIx r ix e @@ -175,10 +168,8 @@ prop_ZoomWithGridStrideCompute :: forall r ix e. ( Eq (Array r ix e) , Show (Array r ix e) - , StrideLoad (R r) ix e , StrideLoad r ix e , Mutable r e - , Extract r ix e ) => Array r ix e -> Stride ix @@ -215,20 +206,17 @@ type Transform r ix e , Function e , Function ix , Eq (Array r ix e) - , Eq (Array (R r) ix e) , Eq (Array r ix Int) , Show (Array r ix e) - , Show (Array (R r) ix e) , Show (Array r ix Int) , NFData (Array r ix e) , NFData (Array r Int e) , Resize r - , Extract r ix e , Construct r ix e , Construct r ix Int - , Source (R r) e + , Ragged L ix e + , Source r e , StrideLoad r ix e - , StrideLoad (R r) ix e , Mutable r Int , Mutable r e) diff --git a/massiv-test/tests/Test/Massiv/ArraySpec.hs b/massiv-test/tests/Test/Massiv/ArraySpec.hs index 23402007..2ce1c0d0 100644 --- a/massiv-test/tests/Test/Massiv/ArraySpec.hs +++ b/massiv-test/tests/Test/Massiv/ArraySpec.hs @@ -48,9 +48,8 @@ prop_Extract :: forall r ix. ( Load D ix Int , Ragged L ix Int - , Load (R r) ix Int , Construct r ix Int - , Extract r ix Int + , Source r Int ) => Comp -> Sz ix @@ -113,7 +112,6 @@ specCommon = it "Functor DI" $ property $ prop_Functor @DI @ix it "Functor DL" $ property $ prop_Functor @DL @ix it "Functor DW" $ property $ prop_Functor @DW @ix - it "Extract DI" $ property $ prop_Extract @DI @ix it "Extract B" $ property $ prop_Extract @B @ix it "Extract N" $ property $ prop_Extract @N @ix it "Extract S" $ property $ prop_Extract @S @ix diff --git a/massiv-test/tests/Test/Massiv/VectorSpec.hs b/massiv-test/tests/Test/Massiv/VectorSpec.hs index d5cd6222..a4d68ee0 100644 --- a/massiv-test/tests/Test/Massiv/VectorSpec.hs +++ b/massiv-test/tests/Test/Massiv/VectorSpec.hs @@ -35,7 +35,7 @@ sizeException :: SizeException -> Bool sizeException exc = exc `deepseq` True toUnboxV2 :: - (Unbox e, Unbox e1, Unbox e2, Index ix1, Index ix2) + Unbox e => (VU.Vector e1 -> VU.Vector e2 -> VU.Vector e) -> Array U ix1 e1 -> Array U ix2 e2 @@ -44,7 +44,7 @@ toUnboxV2 f v1 v2 = fromUnboxedVector (getComp v1 <> getComp v2) (f (toUnboxedVector v1) (toUnboxedVector v2)) toUnboxV3 :: - (Unbox e, Unbox e1, Unbox e2, Unbox e3, Index ix1, Index ix2, Index ix3) + Unbox e => (VU.Vector e1 -> VU.Vector e2 -> VU.Vector e3 -> VU.Vector e) -> Array U ix1 e1 -> Array U ix2 e2 @@ -53,7 +53,7 @@ toUnboxV3 :: toUnboxV3 f v1 v2 v3 = appComp (getComp v1) (toUnboxV2 (f (toUnboxedVector v1)) v2 v3) toUnboxV4 :: - (Unbox e, Unbox e1, Unbox e2, Unbox e3, Unbox e4, Index ix1, Index ix2, Index ix3, Index ix4) + 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 @@ -63,18 +63,7 @@ toUnboxV4 :: toUnboxV4 f v1 v2 v3 v4 = appComp (getComp v1) (toUnboxV3 (f (toUnboxedVector v1)) v2 v3 v4) toUnboxV5 :: - ( Unbox e - , Unbox e1 - , Unbox e2 - , Unbox e3 - , Unbox e4 - , Unbox e5 - , Index ix1 - , Index ix2 - , Index ix3 - , Index ix4 - , Index ix5 - ) + 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 @@ -85,20 +74,7 @@ toUnboxV5 :: toUnboxV5 f v1 v2 v3 v4 v5 = appComp (getComp v1) (toUnboxV4 (f (toUnboxedVector v1)) v2 v3 v4 v5) toUnboxV6 :: - ( Unbox e - , Unbox e1 - , Unbox e2 - , Unbox e3 - , Unbox e4 - , Unbox e5 - , Unbox e6 - , Index ix1 - , Index ix2 - , Index ix3 - , Index ix4 - , Index ix5 - , Index ix6 - ) + 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 @@ -808,11 +784,11 @@ spec = slength (sfromList []) `shouldBe` Nothing slength (sfromListN 1 []) `shouldBe` Nothing slength (sgenerate 1 id) `shouldBe` Just 1 - it "snull" $ do - snull sempty `shouldBe` True - snull (fromLists' Seq [[]] :: Array P Ix2 Int) `shouldBe` True - snull (siterateN 3 id ()) `shouldBe` False - snull (0 ..: 1 :> 2 :> 3 :. 0) `shouldBe` True + it "isNull" $ do + isNull sempty `shouldBe` True + isNull (fromLists' Seq [[]] :: Array P Ix2 Int) `shouldBe` True + isNull (siterateN 3 id ()) `shouldBe` False + isNull (0 ..: 1 :> 2 :> 3 :. 0) `shouldBe` True describe "Indexing" $ do prop "head' (non-empty)" $ \(ArrNE arr :: ArrNE D Ix1 Int) -> head' arr === evaluate' arr 0 .&&. head' arr === shead' arr diff --git a/massiv/CHANGELOG.md b/massiv/CHANGELOG.md index f996c58a..d7f17735 100644 --- a/massiv/CHANGELOG.md +++ b/massiv/CHANGELOG.md @@ -12,6 +12,7 @@ * Remove `ix` from `Resize` * Prevent `showsArrayPrec` from changing index type * Change function argument to monadic action for `unstablePartitionM` and `unsafeUnstablePartitionM` +* Replace `snull` with a more generic `isNull` # 0.6.1 diff --git a/massiv/massiv.cabal b/massiv/massiv.cabal index 86b6ab7b..58de2b30 100644 --- a/massiv/massiv.cabal +++ b/massiv/massiv.cabal @@ -1,5 +1,5 @@ name: massiv -version: 0.6.1.0 +version: 1.0.0.0 synopsis: Massiv (Массив) is an Array Library. description: Multi-dimensional Arrays with fusion, stencils and parallel computation. homepage: https://github.com/lehins/massiv diff --git a/massiv/src/Data/Massiv/Array.hs b/massiv/src/Data/Massiv/Array.hs index 23caa281..da3528ad 100644 --- a/massiv/src/Data/Massiv/Array.hs +++ b/massiv/src/Data/Massiv/Array.hs @@ -108,6 +108,8 @@ module Data.Massiv.Array , elemsCount , isEmpty , isNotEmpty + , isNull + , isNotNull -- * Indexing , (!?) , (!) diff --git a/massiv/src/Data/Massiv/Array/Delayed/Interleaved.hs b/massiv/src/Data/Massiv/Array/Delayed/Interleaved.hs index 5c4ef345..c936d187 100644 --- a/massiv/src/Data/Massiv/Array/Delayed/Interleaved.hs +++ b/massiv/src/Data/Massiv/Array/Delayed/Interleaved.hs @@ -60,10 +60,6 @@ instance Resize DI where unsafeResize sz = DIArray . unsafeResize sz . diArray {-# INLINE unsafeResize #-} -instance Index ix => Extract DI ix e where - unsafeExtract sIx newSz = DIArray . unsafeExtract sIx newSz . diArray - {-# INLINE unsafeExtract #-} - instance Index ix => Load DI ix e where loadArrayM scheduler (DIArray (DArray _ sz f)) uWrite = diff --git a/massiv/src/Data/Massiv/Array/Delayed/Pull.hs b/massiv/src/Data/Massiv/Array/Delayed/Pull.hs index b863cc89..f8715e69 100644 --- a/massiv/src/Data/Massiv/Array/Delayed/Pull.hs +++ b/massiv/src/Data/Massiv/Array/Delayed/Pull.hs @@ -22,6 +22,9 @@ module Data.Massiv.Array.Delayed.Pull , compareArrays , imap , liftArray2Matching + , unsafeExtract + , unsafeSlice + , unsafeInnerSlice ) where import Control.Applicative @@ -36,9 +39,11 @@ import Prelude hiding (zipWith) #include "massiv.h" + -- | Delayed representation. data D = D deriving Show + data instance Array D ix e = DArray { dComp :: !Comp , dSize :: !(Sz ix) , dIndex :: ix -> e } @@ -61,12 +66,6 @@ instance Resize D where unsafeIndex arr (fromLinearIndex (size arr) (toLinearIndex sz ix)) {-# INLINE unsafeResize #-} -instance Index ix => Extract D ix e where - unsafeExtract !sIx !newSz !arr = - DArray (dComp arr) newSz $ \ !ix -> - unsafeIndex arr (liftIndex2 (+) ix sIx) - {-# INLINE unsafeExtract #-} - instance Strategy D where setComp c arr = arr { dComp = c } {-# INLINE setComp #-} @@ -81,33 +80,36 @@ instance Index ix => Construct D ix e where instance Source D e where unsafeIndex = INDEX_CHECK("(Source D ix e).unsafeIndex", size, dIndex) {-# INLINE unsafeIndex #-} + + unsafeOuterSlice !arr !szL !i = DArray (dComp arr) szL (unsafeIndex arr . consDim i) + {-# INLINE unsafeOuterSlice #-} + unsafeLinearSlice !o !sz arr = DArray (dComp arr) sz $ \ !i -> unsafeIndex arr (fromLinearIndex (size arr) (i + o)) {-# INLINE unsafeLinearSlice #-} -instance ( Index ix - , Index (Lower ix) - , Elt D ix e ~ Array D (Lower ix) e - ) => - Slice D ix e where - unsafeSlice arr start cut@(SafeSz cutSz) dim = do - newSz <- dropDimM cutSz dim - return $ unsafeResize (SafeSz newSz) (unsafeExtract start cut arr) - {-# INLINE unsafeSlice #-} - +-- | /O(1)/ - Extract a portion of an array. Staring index and new size are +-- not validated. +unsafeExtract :: (Source r e, Index ix) => ix -> Sz ix -> Array r ix e -> Array D ix e +unsafeExtract !sIx !newSz !arr = + DArray (getComp arr) newSz (unsafeIndex arr . liftIndex2 (+) sIx) +{-# INLINE unsafeExtract #-} -instance (Elt D ix e ~ Array D (Lower ix) e, Index ix) => OuterSlice D ix e where - - unsafeOuterSlice !arr !i = - DArray (dComp arr) (snd (unconsSz (size arr))) (\ !ix -> unsafeIndex arr (consDim i ix)) - {-# INLINE unsafeOuterSlice #-} +-- | /O(1)/ - Take a slice out of an array from within +unsafeSlice :: (Source r e, Index ix, Index (Lower ix), MonadThrow m) => + Array r ix e -> ix -> Sz ix -> Dim -> m (Array D (Lower ix) e) +unsafeSlice arr start cut@(SafeSz cutSz) dim = do + newSz <- dropDimM cutSz dim + return $ unsafeResize (SafeSz newSz) (unsafeExtract start cut arr) +{-# INLINE unsafeSlice #-} -instance (Elt D ix e ~ Array D (Lower ix) e, Index ix) => InnerSlice D ix e where +-- | /O(1)/ - Take a slice out of an array from the inside +unsafeInnerSlice :: + (Source r e, Index ix) => Array r ix e -> Sz (Lower ix) -> Int -> Array D (Lower ix) e +unsafeInnerSlice !arr szL !i = DArray (getComp arr) szL (unsafeIndex arr . (`snocDim` i)) +{-# INLINE unsafeInnerSlice #-} - unsafeInnerSlice !arr (szL, _) !i = - DArray (dComp arr) szL (\ !ix -> unsafeIndex arr (snocDim ix i)) - {-# INLINE unsafeInnerSlice #-} instance (Eq e, Index ix) => Eq (Array D ix e) where diff --git a/massiv/src/Data/Massiv/Array/Delayed/Stream.hs b/massiv/src/Data/Massiv/Array/Delayed/Stream.hs index 7792414c..0edf55a6 100644 --- a/massiv/src/Data/Massiv/Array/Delayed/Stream.hs +++ b/massiv/src/Data/Massiv/Array/Delayed/Stream.hs @@ -73,8 +73,8 @@ instance Shape DS Ix1 where outerSize = linearSize {-# INLINE outerSize #-} - isEmpty = S.unId . S.null . coerce - {-# INLINE isEmpty #-} + isNull = S.unId . S.null . coerce + {-# INLINE isNull #-} --TODO remove diff --git a/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs b/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs index 9cb185a7..19eaa81d 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs @@ -61,7 +61,7 @@ import Control.Monad.Primitive import qualified Data.Foldable as F (Foldable(..)) import Data.Massiv.Array.Delayed.Push (DL) import Data.Massiv.Array.Delayed.Stream (DS) -import Data.Massiv.Array.Manifest.Internal (M, computeAs, toManifest) +import Data.Massiv.Array.Manifest.Internal (computeAs) import Data.Massiv.Array.Manifest.List as L import Data.Massiv.Array.Mutable import Data.Massiv.Array.Ops.Fold @@ -150,6 +150,9 @@ instance Source BL e where SafeSz . sizeofArray, A.indexArray) a (i + o) {-# INLINE unsafeLinearIndex #-} + unsafeOuterSlice (BLArray c _ o a) szL i = BLArray c szL (i * totalElem szL + o) a + {-# INLINE unsafeOuterSlice #-} + unsafeLinearSlice i k (BLArray c _ o a) = BLArray c k (o + i) a {-# INLINE unsafeLinearSlice #-} @@ -158,22 +161,6 @@ instance Resize BL where unsafeResize !sz !arr = arr { blSize = sz } {-# INLINE unsafeResize #-} -instance Index ix => Extract BL ix e where - unsafeExtract !sIx !newSz !arr = unsafeExtract sIx newSz (toManifest arr) - {-# INLINE unsafeExtract #-} - -instance (Elt BL ix e ~ Elt M ix e, Slice M ix e) => Slice BL ix e where - unsafeSlice = unsafeSlice . toManifest - {-# INLINE unsafeSlice #-} - -instance (Elt BL ix e ~ Elt M ix e, OuterSlice M ix e) => OuterSlice BL ix e where - unsafeOuterSlice = unsafeOuterSlice . toManifest - {-# INLINE unsafeOuterSlice #-} - -instance (Elt BL ix e ~ Elt M ix e, InnerSlice M ix e) => InnerSlice BL ix e where - unsafeInnerSlice = unsafeInnerSlice . toManifest - {-# INLINE unsafeInnerSlice #-} - instance Manifest BL e where @@ -226,7 +213,6 @@ instance Index ix => Shape BL ix where {-# INLINE maxLinearSize #-} instance Index ix => Load BL ix e where - type R BL = M loadArrayM !scheduler !arr = splitLinearlyWith_ scheduler (elemsCount arr) (unsafeLinearIndex arr) {-# INLINE loadArrayM #-} @@ -340,6 +326,9 @@ instance Source B e where unsafeLinearSlice i k arr = coerce (unsafeLinearSlice i k (toLazyArray arr)) {-# INLINE unsafeLinearSlice #-} + unsafeOuterSlice arr i = coerce (unsafeOuterSlice (toLazyArray arr) i) + {-# INLINE unsafeOuterSlice #-} + instance Strategy B where getComp = blComp . coerce {-# INLINE getComp #-} @@ -358,23 +347,6 @@ instance Size B where size = blSize . coerce {-# INLINE size #-} -instance Index ix => Extract B ix e where - unsafeExtract !sIx !newSz !arr = unsafeExtract sIx newSz (toManifest arr) - {-# INLINE unsafeExtract #-} - - -instance (Elt B ix e ~ Elt M ix e, Slice M ix e) => Slice B ix e where - unsafeSlice = unsafeSlice . toManifest - {-# INLINE unsafeSlice #-} - -instance (Elt B ix e ~ Elt M ix e, OuterSlice M ix e) => OuterSlice B ix e where - unsafeOuterSlice = unsafeOuterSlice . toManifest - {-# INLINE unsafeOuterSlice #-} - -instance (Elt B ix e ~ Elt M ix e, InnerSlice M ix e) => InnerSlice B ix e where - unsafeInnerSlice = unsafeInnerSlice . toManifest - {-# INLINE unsafeInnerSlice #-} - instance Manifest B e where @@ -413,7 +385,6 @@ instance Mutable B e where {-# INLINE unsafeLinearWrite #-} instance Index ix => Load B ix e where - type R B = M loadArrayM scheduler = coerce (loadArrayM scheduler) {-# INLINE loadArrayM #-} @@ -534,8 +505,10 @@ instance (Index ix, NFData e) => Construct BN ix e where instance NFData e => Source BN e where unsafeLinearIndex (BNArray arr) = unsafeLinearIndex arr {-# INLINE unsafeLinearIndex #-} - unsafeLinearSlice i k (BNArray a) = BNArray $ unsafeLinearSlice i k a + unsafeLinearSlice i k (BNArray a) = coerce (unsafeLinearSlice i k a) {-# INLINE unsafeLinearSlice #-} + unsafeOuterSlice (BNArray a) i = coerce (unsafeOuterSlice a i) + {-# INLINE unsafeOuterSlice #-} instance Index ix => Shape BN ix where @@ -550,23 +523,6 @@ instance Resize BN where unsafeResize !sz = coerce . unsafeResize sz . coerce {-# INLINE unsafeResize #-} -instance (Index ix, NFData e) => Extract BN ix e where - unsafeExtract !sIx !newSz !arr = unsafeExtract sIx newSz (toManifest arr) - {-# INLINE unsafeExtract #-} - - -instance (NFData e, Elt BN ix e ~ Elt M ix e, Slice M ix e) => Slice BN ix e where - unsafeSlice = unsafeSlice . toManifest - {-# INLINE unsafeSlice #-} - -instance (NFData e, Elt BN ix e ~ Elt M ix e, OuterSlice M ix e) => OuterSlice BN ix e where - unsafeOuterSlice = unsafeOuterSlice . toManifest - {-# INLINE unsafeOuterSlice #-} - -instance (NFData e, Elt BN ix e ~ Elt M ix e, InnerSlice M ix e) => InnerSlice BN ix e where - unsafeInnerSlice = unsafeInnerSlice . toManifest - {-# INLINE unsafeInnerSlice #-} - instance NFData e => Manifest BN e where unsafeLinearIndexM arr = unsafeLinearIndexM (coerce arr) {-# INLINE unsafeLinearIndexM #-} @@ -603,7 +559,6 @@ instance NFData e => Mutable BN e where {-# INLINE unsafeLinearWrite #-} instance (Index ix, NFData e) => Load BN ix e where - type R BN = M loadArrayM !scheduler !arr = splitLinearlyWith_ scheduler (elemsCount arr) (unsafeLinearIndex arr) {-# INLINE loadArrayM #-} diff --git a/massiv/src/Data/Massiv/Array/Manifest/Internal.hs b/massiv/src/Data/Massiv/Array/Manifest/Internal.hs index b8757371..f3f31ab3 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Internal.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Internal.hs @@ -42,9 +42,6 @@ module Data.Massiv.Array.Manifest.Internal , sizeofMutableArray , iterateUntil , iterateUntilM - , unsafeSliceN - , unsafeOuterSliceN - , unsafeInnerSliceN ) where import Control.Exception (try) @@ -142,7 +139,11 @@ instance Strategy M where instance Source M e where unsafeLinearIndex = mLinearIndex {-# INLINE unsafeLinearIndex #-} - unsafeLinearSlice ix sz arr = unsafeExtract ix sz (unsafeResize sz arr) + + unsafeOuterSlice = unsafeOuterSliceN + {-# INLINE unsafeOuterSlice #-} + + unsafeLinearSlice off sz arr = MArray (getComp arr) sz (unsafeLinearIndex arr . (+ off)) {-# INLINE unsafeLinearSlice #-} @@ -161,146 +162,20 @@ instance Resize M where unsafeResize !sz !arr = arr { mSize = sz } {-# INLINE unsafeResize #-} -instance Index ix => Extract M ix e where - unsafeExtract !sIx !newSz !arr = - MArray (getComp arr) newSz $ \ i -> - unsafeIndex arr (liftIndex2 (+) (fromLinearIndex newSz i) sIx) - {-# INLINE unsafeExtract #-} - - -unsafeSliceN :: - (MonadThrow m, Resize (R r), Extract r ix e, Index (Lower ix)) - => Array r ix e - -> ix - -> Sz ix - -> Dim - -> m (Array (R r) (Lower ix) e) -unsafeSliceN arr start cutSz dim = do - (_, newSz) <- pullOutSzM cutSz dim - return $ unsafeResize newSz (unsafeExtract start cutSz arr) -{-# INLINE unsafeSliceN #-} - -instance Slice M Ix1 e where - unsafeSlice arr i _ _ = pure (unsafeLinearIndex arr i) - {-# INLINE unsafeSlice #-} - -instance Slice M Ix2 e where - unsafeSlice = unsafeSliceN - {-# INLINE unsafeSlice #-} - -instance {-# OVERLAPPING #-} Slice M Ix3 e where - unsafeSlice = unsafeSliceN - {-# INLINE unsafeSlice #-} - -instance HighIxN n => Slice M (IxN n) e where - unsafeSlice = unsafeSliceN - {-# INLINE unsafeSlice #-} - -instance Slice M Ix2T e where - unsafeSlice = unsafeSliceN - {-# INLINE unsafeSlice #-} - -instance Slice M Ix3T e where - unsafeSlice = unsafeSliceN - {-# INLINE unsafeSlice #-} -instance Slice M Ix4T e where - unsafeSlice = unsafeSliceN - {-# INLINE unsafeSlice #-} - -instance Slice M Ix5T e where - unsafeSlice = unsafeSliceN - {-# INLINE unsafeSlice #-} unsafeOuterSliceN :: forall r ix e. (Source r e, Index ix, Index (Lower ix)) => Array r ix e + -> Sz (Lower ix) -> Int -> Array M (Lower ix) e -unsafeOuterSliceN !arr !i = - MArray (getComp arr) (snd (unconsSz (size arr))) (unsafeLinearIndex arr . (+ kStart)) +unsafeOuterSliceN !arr szL !i = MArray (getComp arr) szL (unsafeLinearIndex arr . (+ kStart)) where !kStart = toLinearIndex (size arr) (consDim i (zeroIndex :: Lower ix)) {-# INLINE unsafeOuterSliceN #-} -instance OuterSlice M Ix1 e where - unsafeOuterSlice !arr = unsafeIndex arr - {-# INLINE unsafeOuterSlice #-} - -instance OuterSlice M Ix2 e where - unsafeOuterSlice = unsafeOuterSliceN - {-# INLINE unsafeOuterSlice #-} - -instance {-# OVERLAPPING #-} OuterSlice M Ix3 e where - unsafeOuterSlice = unsafeOuterSliceN - {-# INLINE unsafeOuterSlice #-} - -instance HighIxN n => OuterSlice M (IxN n) e where - unsafeOuterSlice = unsafeOuterSliceN - {-# INLINE unsafeOuterSlice #-} - -instance OuterSlice M Ix2T e where - unsafeOuterSlice = unsafeOuterSliceN - {-# INLINE unsafeOuterSlice #-} - -instance OuterSlice M Ix3T e where - unsafeOuterSlice = unsafeOuterSliceN - {-# INLINE unsafeOuterSlice #-} - -instance OuterSlice M Ix4T e where - unsafeOuterSlice = unsafeOuterSliceN - {-# INLINE unsafeOuterSlice #-} - -instance OuterSlice M Ix5T e where - unsafeOuterSlice = unsafeOuterSliceN - {-# INLINE unsafeOuterSlice #-} - - -instance InnerSlice M Ix1 e where - unsafeInnerSlice !arr _ = unsafeIndex arr - {-# INLINE unsafeInnerSlice #-} - -unsafeInnerSliceN :: - forall r ix e. (Index ix, Index (Lower ix), Source r e) - => Array r ix e - -> (Sz (Lower ix), Sz Int) - -> Int - -> Array M (Lower ix) e -unsafeInnerSliceN !arr (szL, m) !i = - MArray (getComp arr) szL (\k -> unsafeLinearIndex arr (k * unSz m + kStart)) - where - !kStart = toLinearIndex (size arr) (snocDim (zeroIndex :: Lower ix) i) -{-# INLINE unsafeInnerSliceN #-} - -instance InnerSlice M Ix2 e where - unsafeInnerSlice = unsafeInnerSliceN - {-# INLINE unsafeInnerSlice #-} - -instance {-# OVERLAPPING #-} InnerSlice M Ix3 e where - unsafeInnerSlice = unsafeInnerSliceN - {-# INLINE unsafeInnerSlice #-} - -instance HighIxN n => InnerSlice M (IxN n) e where - unsafeInnerSlice = unsafeInnerSliceN - {-# INLINE unsafeInnerSlice #-} - -instance InnerSlice M Ix2T e where - unsafeInnerSlice = unsafeInnerSliceN - {-# INLINE unsafeInnerSlice #-} - -instance InnerSlice M Ix3T e where - unsafeInnerSlice = unsafeInnerSliceN - {-# INLINE unsafeInnerSlice #-} - -instance InnerSlice M Ix4T e where - unsafeInnerSlice = unsafeInnerSliceN - {-# INLINE unsafeInnerSlice #-} - -instance InnerSlice M Ix5T e where - unsafeInnerSlice = unsafeInnerSliceN - {-# INLINE unsafeInnerSlice #-} - instance Index ix => Load M ix e where loadArrayM scheduler (MArray _ sz f) = splitLinearlyWith_ scheduler (totalElem sz) f {-# INLINE loadArrayM #-} diff --git a/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs b/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs index ddfc80cc..90437f88 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs @@ -116,14 +116,6 @@ instance (Prim e, Index ix) => Construct P ix e where replicate comp !sz !e = runST (newMArray sz e >>= unsafeFreeze comp) {-# INLINE replicate #-} -instance Prim e => Source P e where - unsafeLinearIndex _arr@(PArray _ _ o a) i = - INDEX_CHECK("(Source P ix e).unsafeLinearIndex", - SafeSz . elemsBA _arr, indexByteArray) a (i + o) - {-# INLINE unsafeLinearIndex #-} - - unsafeLinearSlice i k (PArray c _ o a) = PArray c k (i + o) a - {-# INLINE unsafeLinearSlice #-} instance Index ix => Shape P ix where maxLinearSize = Just . SafeSz . elemsCount @@ -137,21 +129,18 @@ instance Resize P where unsafeResize !sz !arr = arr { pSize = sz } {-# INLINE unsafeResize #-} -instance (Prim e, Index ix) => Extract P ix e where - unsafeExtract !sIx !newSz !arr = unsafeExtract sIx newSz (toManifest arr) - {-# INLINE unsafeExtract #-} - -instance (Prim e, Elt P ix e ~ Elt M ix e, Slice M ix e) => Slice P ix e where - unsafeSlice = unsafeSlice . toManifest - {-# INLINE unsafeSlice #-} +instance Prim e => Source P e where + unsafeLinearIndex _arr@(PArray _ _ o a) i = + INDEX_CHECK("(Source P ix e).unsafeLinearIndex", + SafeSz . elemsBA _arr, indexByteArray) a (i + o) + {-# INLINE unsafeLinearIndex #-} -instance (Prim e, Elt P ix e ~ Elt M ix e, OuterSlice M ix e) => OuterSlice P ix e where - unsafeOuterSlice = unsafeOuterSlice . toManifest + unsafeOuterSlice (PArray c _ o a) szL i = + PArray c szL (i * totalElem szL + o) a {-# INLINE unsafeOuterSlice #-} -instance (Prim e, Elt P ix e ~ Elt M ix e, InnerSlice M ix e) => InnerSlice P ix e where - unsafeInnerSlice = unsafeInnerSlice . toManifest - {-# INLINE unsafeInnerSlice #-} + unsafeLinearSlice i k (PArray c _ o a) = PArray c k (i + o) a + {-# INLINE unsafeLinearSlice #-} instance Prim e => Manifest P e where @@ -222,7 +211,6 @@ instance Prim e => Mutable P e where instance (Prim e, Index ix) => Load P ix e where - type R P = M loadArrayM !scheduler !arr = splitLinearlyWith_ scheduler (elemsCount arr) (unsafeLinearIndex arr) {-# INLINE loadArrayM #-} diff --git a/massiv/src/Data/Massiv/Array/Manifest/Storable.hs b/massiv/src/Data/Massiv/Array/Manifest/Storable.hs index 65c966dd..4e90089e 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Storable.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Storable.hs @@ -108,6 +108,12 @@ instance VS.Storable e => Source S e where unsafeLinearIndex (SArray _ _ v) = INDEX_CHECK("(Source S ix e).unsafeLinearIndex", Sz . VS.length, VS.unsafeIndex) v {-# INLINE unsafeLinearIndex #-} + + unsafeOuterSlice (SArray c _ v) szL i = + let k = totalElem szL + in SArray c szL $ VS.unsafeSlice (i * k) k v + {-# INLINE unsafeOuterSlice #-} + unsafeLinearSlice i k (SArray c _ v) = SArray c k $ VS.unsafeSlice i (unSz k) v {-# INLINE unsafeLinearSlice #-} @@ -123,25 +129,6 @@ instance Resize S where unsafeResize !sz !arr = arr { sSize = sz } {-# INLINE unsafeResize #-} -instance (Storable e, Index ix) => Extract S ix e where - unsafeExtract !sIx !newSz !arr = unsafeExtract sIx newSz (toManifest arr) - {-# INLINE unsafeExtract #-} - - - -instance (Storable e, Elt S ix e ~ Elt M ix e, Slice M ix e) => Slice S ix e where - unsafeSlice = unsafeSlice . toManifest - {-# INLINE unsafeSlice #-} - -instance (Storable e, Elt S ix e ~ Elt M ix e, OuterSlice M ix e) => OuterSlice S ix e where - unsafeOuterSlice = unsafeOuterSlice . toManifest - {-# INLINE unsafeOuterSlice #-} - -instance (Storable e, Elt S ix e ~ Elt M ix e, InnerSlice M ix e) => InnerSlice S ix e where - unsafeInnerSlice = unsafeInnerSlice . toManifest - {-# INLINE unsafeInnerSlice #-} - - instance Storable e => Manifest S e where unsafeLinearIndexM (SArray _ _ v) = @@ -217,7 +204,6 @@ instance Storable e => Mutable S e where instance (Index ix, Storable e) => Load S ix e where - type R S = M loadArrayM !scheduler !arr = splitLinearlyWith_ scheduler (elemsCount arr) (unsafeLinearIndex arr) {-# INLINE loadArrayM #-} diff --git a/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs b/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs index 63d65add..47770b90 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs @@ -26,7 +26,6 @@ module Data.Massiv.Array.Manifest.Unboxed import Control.DeepSeq (NFData(..), deepseq) import Data.Massiv.Array.Delayed.Pull (eqArrays, compareArrays) -import Data.Massiv.Array.Manifest.Internal (M, toManifest) import Data.Massiv.Array.Manifest.List as A import Data.Massiv.Vector.Stream as S (steps, isteps) import Data.Massiv.Array.Mutable @@ -90,6 +89,12 @@ instance Unbox e => Source U e where unsafeLinearIndex (UArray _ _ v) = INDEX_CHECK("(Source U ix e).unsafeLinearIndex", Sz . VU.length, VU.unsafeIndex) v {-# INLINE unsafeLinearIndex #-} + + unsafeOuterSlice (UArray c _ v) szL i = + let k = totalElem szL + in UArray c szL $ VU.unsafeSlice (i * k) k v + {-# INLINE unsafeOuterSlice #-} + unsafeLinearSlice i k (UArray c _ v) = UArray c k $ VU.unsafeSlice i (unSz k) v {-# INLINE unsafeLinearSlice #-} @@ -105,31 +110,13 @@ instance Resize U where unsafeResize !sz !arr = arr { uSize = sz } {-# INLINE unsafeResize #-} -instance (Unbox e, Index ix) => Extract U ix e where - unsafeExtract !sIx !newSz !arr = unsafeExtract sIx newSz (toManifest arr) - {-# INLINE unsafeExtract #-} - instance (Unbox e, Index ix) => Load U ix e where - type R U = M loadArrayM !scheduler !arr = splitLinearlyWith_ scheduler (elemsCount arr) (unsafeLinearIndex arr) {-# INLINE loadArrayM #-} instance (Unbox e, Index ix) => StrideLoad U ix e -instance (Unbox e, Elt U ix e ~ Elt M ix e, Slice M ix e) => Slice U ix e where - unsafeSlice = unsafeSlice . toManifest - {-# INLINE unsafeSlice #-} - -instance (Unbox e, Elt U ix e ~ Elt M ix e, OuterSlice M ix e) => OuterSlice U ix e where - unsafeOuterSlice = unsafeOuterSlice . toManifest - {-# INLINE unsafeOuterSlice #-} - -instance (Unbox e, Elt U ix e ~ Elt M ix e, InnerSlice M ix e) => InnerSlice U ix e where - unsafeInnerSlice = unsafeInnerSlice . toManifest - {-# INLINE unsafeInnerSlice #-} - - instance Unbox e => Manifest U e where unsafeLinearIndexM (UArray _ _ v) = diff --git a/massiv/src/Data/Massiv/Array/Mutable.hs b/massiv/src/Data/Massiv/Array/Mutable.hs index b1c0f3a5..d4537051 100644 --- a/massiv/src/Data/Massiv/Array/Mutable.hs +++ b/massiv/src/Data/Massiv/Array/Mutable.hs @@ -226,7 +226,7 @@ thawS arr = do -- ==== __Example__ -- -- >>> import Data.Massiv.Array --- >>> marr <- newMArray @P @_ @Int (Sz2 2 6) 0 +-- >>> marr <- newMArray @P (Sz2 2 6) (0 :: Int) -- >>> forM_ (range Seq 0 (Ix2 1 4)) $ \ix -> write marr ix 9 -- >>> freeze Seq marr -- Array P Seq (Sz (2 :. 6)) diff --git a/massiv/src/Data/Massiv/Array/Numeric.hs b/massiv/src/Data/Massiv/Array/Numeric.hs index ffb466be..332f533d 100644 --- a/massiv/src/Data/Massiv/Array/Numeric.hs +++ b/massiv/src/Data/Massiv/Array/Numeric.hs @@ -551,7 +551,7 @@ multiplyMatrices arrA arrB -- mA == 1 = -- TODO: call multiplyVectorByMatrix -- nA == 1 = -- TODO: call multiplyMatrixByVector | nA /= mB = throwM $ SizeMismatchException (size arrA) (size arrB) - | isNull arrA || isNull arrB = pure $ runST (unsafeFreeze comp =<< unsafeNew zeroSz) + | isEmpty arrA || isEmpty arrB = pure $ runST (unsafeFreeze comp =<< unsafeNew zeroSz) | otherwise = pure $! unsafePerformIO $ do marrC <- newMArray (SafeSz (mA :. nB)) 0 withScheduler_ comp $ \scheduler -> do @@ -698,7 +698,7 @@ multiplyMatricesTransposed :: -> m (Matrix D e) multiplyMatricesTransposed arr1 arr2 | n1 /= m2 = throwM $ SizeMismatchException (size arr1) (Sz2 m2 n2) - | isNull arr1 || isNull arr2 = pure $ setComp comp empty + | isEmpty arr1 || isEmpty arr2 = pure $ setComp comp empty | otherwise = pure $ DArray comp (SafeSz (m1 :. n2)) $ \(i :. j) -> diff --git a/massiv/src/Data/Massiv/Array/Numeric/Integral.hs b/massiv/src/Data/Massiv/Array/Numeric/Integral.hs index 882b1481..1f4be6b7 100644 --- a/massiv/src/Data/Massiv/Array/Numeric/Integral.hs +++ b/massiv/src/Data/Massiv/Array/Numeric/Integral.hs @@ -132,7 +132,7 @@ integralApprox :: -> Sz ix -- ^ @sz@ - Result size of the matrix -> Int -- ^ @n@ - Number of samples -> Array r ix e -- ^ Array with values of @f(x,y,..)@ that will be used as source for integration. - -> Array M ix e + -> Array D ix e integralApprox stencil d sz n arr = extract' zeroIndex sz $ toManifest $ loop 1 (<= coerce (dimensions sz)) (+ 1) arr integrateAlong where @@ -152,7 +152,7 @@ midpointRule :: -> e -- ^ @d@ - Distance per matrix cell. -> Sz ix -- ^ @sz@ - Result matrix size. -> Int -- ^ @n@ - Number of sample points per cell in each direction. - -> Array M ix e + -> Array D ix e midpointRule comp r f a d sz n = integralApprox midpointStencil d sz n $ computeAs r $ fromFunctionMidpoint comp f a d sz n {-# INLINE midpointRule #-} @@ -168,7 +168,7 @@ trapezoidRule :: -> e -- ^ @d@ - Distance per matrix cell. -> Sz ix -- ^ @sz@ - Result matrix size. -> Int -- ^ @n@ - Number of sample points per cell in each direction. - -> Array M ix e + -> Array D ix e trapezoidRule comp r f a d sz n = integralApprox trapezoidStencil d sz n $ computeAs r $ fromFunction comp f a d sz n {-# INLINE trapezoidRule #-} @@ -184,7 +184,7 @@ simpsonsRule :: -> Sz ix -- ^ @sz@ - Result matrix size. -> Int -- ^ @n@ - Number of sample points per cell in each direction. This value must be even, -- otherwise error. - -> Array M ix e + -> Array D ix e simpsonsRule comp r f a d sz n = integralApprox simpsonsStencil d sz n $ computeAs r $ fromFunction comp f a d sz n {-# INLINE simpsonsRule #-} @@ -282,7 +282,7 @@ fromFunctionMidpoint comp f a d (Sz sz) n = -- stencils to compute an integral, but there are already functions that will do both steps for you: -- -- >>> simpsonsRule Seq U (\ scale x -> f (scale x)) 0 2 (Sz1 1) 4 --- Array M Seq (Sz1 1) +-- Array D Seq (Sz1 1) -- [ 17.353626 ] -- -- @scale@ is the function that will change an array index into equally spaced and @@ -318,7 +318,7 @@ fromFunctionMidpoint comp f a d (Sz sz) n = -- [ -2.0, -1.75, -1.5, -1.25, -1.0, -0.75, -0.5, -0.25, 0.0, 0.25, 0.5, 0.75, 1.0, 1.25, 1.5, 1.75, 2.0 ] -- >>> yArrX4 = computeAs U $ fmap f xArrX4 -- >>> integralApprox trapezoidStencil distPerCell desiredSize numSamples yArrX4 --- Array M Seq (Sz1 4) +-- Array D Seq (Sz1 4) -- [ 16.074406, 1.4906789, 1.4906789, 16.074408 ] -- -- We can clearly see the difference is huge, but it doesn't mean it is much better than our @@ -327,5 +327,5 @@ fromFunctionMidpoint comp f a d (Sz sz) n = -- and `yArr`, there are functions like `simpsonRule` that will take care it for you: -- -- >>> simpsonsRule Seq U (\ scale i -> f (scale i)) startValue distPerCell desiredSize 128 --- Array M Seq (Sz1 4) +-- Array D Seq (Sz1 4) -- [ 14.989977, 1.4626511, 1.4626517, 14.989977 ] diff --git a/massiv/src/Data/Massiv/Array/Ops/Fold.hs b/massiv/src/Data/Massiv/Array/Ops/Fold.hs index 8aaa682d..8b906dcd 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Fold.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Fold.hs @@ -342,7 +342,11 @@ foldWithin' dim = foldlWithin' dim mappend mempty -- 1620 -- -- @since 0.4.3 -foldOuterSlice :: (OuterSlice r ix e, Monoid m) => (Elt r ix e -> m) -> Array r ix e -> m +foldOuterSlice :: + (Index ix, Index (Lower ix), Source r e, Monoid m) + => (Array r (Lower ix) e -> m) + -> Array r ix e + -> m foldOuterSlice f = ifoldOuterSlice (const f) {-# INLINE foldOuterSlice #-} @@ -351,10 +355,15 @@ foldOuterSlice f = ifoldOuterSlice (const f) -- together -- -- @since 0.4.3 -ifoldOuterSlice :: (OuterSlice r ix e, Monoid m) => (Ix1 -> Elt r ix e -> m) -> Array r ix e -> m -ifoldOuterSlice f arr = foldMono g $ range (getComp arr) 0 (headDim (unSz (size arr))) +ifoldOuterSlice :: + (Index ix, Index (Lower ix), Source r e, Monoid m) + => (Ix1 -> Array r (Lower ix) e -> m) + -> Array r ix e + -> m +ifoldOuterSlice f arr = foldMono g $ range (getComp arr) 0 k where - g i = f i (unsafeOuterSlice arr i) + (Sz1 k, szL) = unconsSz $ size arr + g i = f i (unsafeOuterSlice arr szL i) {-# INLINE g #-} {-# INLINE ifoldOuterSlice #-} @@ -377,7 +386,8 @@ ifoldOuterSlice f arr = foldMono g $ range (getComp arr) 0 (headDim (unSz (size -- 19575 -- -- @since 0.4.3 -foldInnerSlice :: (InnerSlice r ix e, Monoid m) => (Elt r ix e -> m) -> Array r ix e -> m +foldInnerSlice :: + (Source r e, Index ix, Monoid m) => (Array D (Lower ix) e -> m) -> Array r ix e -> m foldInnerSlice f = ifoldInnerSlice (const f) {-# INLINE foldInnerSlice #-} @@ -386,11 +396,12 @@ foldInnerSlice f = ifoldInnerSlice (const f) -- results together -- -- @since 0.4.3 -ifoldInnerSlice :: (InnerSlice r ix e, Monoid m) => (Ix1 -> Elt r ix e -> m) -> Array r ix e -> m +ifoldInnerSlice :: + (Source r e, Index ix, Monoid m) => (Ix1 -> Array D (Lower ix) e -> m) -> Array r ix e -> m ifoldInnerSlice f arr = foldMono g $ range (getComp arr) 0 (unSz k) where - szs@(_, !k) = unsnocSz (size arr) - g i = f i (unsafeInnerSlice arr szs i) + (szL, !k) = unsnocSz (size arr) + g i = f i (unsafeInnerSlice arr szL i) {-# INLINE g #-} {-# INLINE ifoldInnerSlice #-} diff --git a/massiv/src/Data/Massiv/Array/Ops/Fold/Internal.hs b/massiv/src/Data/Massiv/Array/Ops/Fold/Internal.hs index 3cfe11ab..34c024b9 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Fold/Internal.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Fold/Internal.hs @@ -335,7 +335,7 @@ ifoldlIO f !initAcc g !tAcc !arr F.foldlM g tAcc results {-# INLINE ifoldlIO #-} --- | Split an array into linear row-major vector chunks and apply an action to each of +-- | Slice an array into linear row-major vector chunks and apply an action to each of -- them. Number of chunks will depend on the computation strategy. Results of each action -- will be combined with a folding function. -- diff --git a/massiv/src/Data/Massiv/Array/Ops/Slice.hs b/massiv/src/Data/Massiv/Array/Ops/Slice.hs index c850f279..42ebe6a8 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Slice.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Slice.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} -- | @@ -62,24 +63,23 @@ infixl 4 !>, !?>, ??>, , , -- ] -- ] -- >>> arr !> 2 --- Array M Seq (Sz (2 :. 4)) +-- Array U Seq (Sz (2 :. 4)) -- [ [ (2,0,0), (2,0,1), (2,0,2), (2,0,3) ] -- , [ (2,1,0), (2,1,1), (2,1,2), (2,1,3) ] -- ] -- --- There is nothing wrong with chaining, mixing and matching slicing operators, or even using them --- to index arrays: +-- There is nothing wrong with chaining, mixing and matching slicing operators: -- --- >>> arr !> 2 !> 0 !> 3 +-- >>> arr !> 2 !> 0 ! 3 -- (2,0,3) --- >>> arr !> 2 >> evaluateM (arr !> 2 >> (arr !> 2 !> 0 !> 3) == (arr ! 2 :> 0 :. 3) +-- >>> (arr !> 2 !> 0 ! 3) == (arr ! 2 :> 0 :. 3) -- True -- -- -- @since 0.1.0 -(!>) :: OuterSlice r ix e => Array r ix e -> Int -> Elt r ix e +(!>) :: (Index ix, Index (Lower ix), Source r e) => Array r ix e -> Int -> Array r (Lower ix) e (!>) !arr !ix = either throw id (arr !?> ix) {-# INLINE (!>) #-} @@ -88,12 +88,15 @@ infixl 4 !>, !?>, ??>, , , -- `Nothing` when index is out of bounds. -- -- @since 0.1.0 -(!?>) :: (MonadThrow m, OuterSlice r ix e) => Array r ix e -> Int -> m (Elt r ix e) -(!?>) !arr !i - | isSafeIndex sz i = pure $ unsafeOuterSlice arr i - | otherwise = throwM $ IndexOutOfBoundsException sz i - where - !sz = fst (unconsSz (size arr)) +(!?>) :: + (MonadThrow m, Index ix, Index (Lower ix), Source r e) + => Array r ix e + -> Int + -> m (Array r (Lower ix) e) +(!?>) !arr !i = do + let (k, szL) = unconsSz (size arr) + unless (isSafeIndex k i) $ throwM $ IndexOutOfBoundsException k i + pure $ unsafeOuterSlice arr szL i {-# INLINE (!?>) #-} @@ -104,15 +107,19 @@ infixl 4 !>, !?>, ??>, , , -- -- >>> import Data.Massiv.Array -- >>> arr = makeArrayR U Seq (Sz (3 :> 2 :. 4)) fromIx3 --- >>> arr !?> 2 ??> 0 ??> 3 :: Maybe Ix3T +-- >>> arr !?> 2 ??> 0 ?? 3 :: Maybe Ix3T -- Just (2,0,3) --- >>> arr !?> 2 ??> 0 ??> -1 :: Maybe Ix3T +-- >>> arr !?> 2 ??> 0 ?? -1 :: Maybe Ix3T -- Nothing -- >>> arr !?> 2 ??> -10 ?? 1 -- *** Exception: IndexOutOfBoundsException: -10 is not safe for (Sz1 2) -- -- @since 0.1.0 -(??>) :: (MonadThrow m, OuterSlice r ix e) => m (Array r ix e) -> Int -> m (Elt r ix e) +(??>) :: + (MonadThrow m, Index ix, Index (Lower ix), Source r e) + => m (Array r ix e) + -> Int + -> m (Array r (Lower ix) e) (??>) marr !ix = marr >>= (!?> ix) {-# INLINE (??>) #-} @@ -120,30 +127,26 @@ infixl 4 !>, !?>, ??>, , , -- | /O(1)/ - Safe slice from the inside -- -- @since 0.1.0 -( Array r ix e -> Int -> m (Elt r ix e) -( Array r ix e -> Int -> m (Array D (Lower ix) e) +(`) slice an array from an opposite direction. -- -- @since 0.1.0 -( Array r ix e -> Int -> Elt r ix e -( res - Left exc -> throw exc +( Array r ix e -> Int -> Array D (Lower ix) e +( m (Array r ix e) -> Int -> m (Elt r ix e) +( m (Array r ix e) -> Int -> m (Array D (Lower ix) e) (>= (, !?>, ??>, , , -- | /O(1)/ - Same as (``), but fails gracefully with a `Nothing`, instead of an error -- -- @since 0.1.0 -() :: (MonadThrow m, Slice r ix e) => Array r ix e -> (Dim, Int) -> m (Elt r ix e) +() :: + (MonadThrow m, Index ix, Index (Lower ix), Source r e) => Array r ix e -> (Dim, Int) -> m (Array D (Lower ix) e) () !arr (dim, i) = do (m, szl) <- pullOutSzM (size arr) dim unless (isSafeIndex m i) $ throwM $ IndexOutOfBoundsException m i @@ -161,7 +165,12 @@ infixl 4 !>, !?>, ??>, , , internalInnerSlice :: - (MonadThrow m, Slice r ix e) => Dim -> Sz ix -> Array r ix e -> Int -> m (Elt r ix e) + (MonadThrow m, Index ix, Index (Lower ix), Source r e) + => Dim + -> Sz ix + -> Array r ix e + -> Ix1 + -> m (Array D (Lower ix) e) internalInnerSlice dim cutSz arr i = do start <- setDimM zeroIndex dim i unsafeSlice arr start cutSz dim @@ -176,18 +185,19 @@ internalInnerSlice dim cutSz arr i = do -- index is out of bounds or dimensions is invalid. -- -- @since 0.1.0 -() :: Slice r ix e => Array r ix e -> (Dim, Int) -> Elt r ix e -() !arr !dix = - case arr dix of - Right res -> res - Left exc -> throw exc +() :: (Index ix, Index (Lower ix), Source r e) => Array r ix e -> (Dim, Int) -> Array D (Lower ix) e +() !arr !dix = throwEither (arr dix) {-# INLINE () #-} -- | /O(1)/ - Safe slicing continuation from within. -- -- @since 0.1.0 -() :: (MonadThrow m, Slice r ix e) => m (Array r ix e) -> (Dim, Int) -> m (Elt r ix e) +() :: + (MonadThrow m, Index ix, Index (Lower ix), Source r e) + => m (Array r ix e) + -> (Dim, Int) + -> m (Array D (Lower ix) e) () !marr !ix = marr >>= ( ix) {-# INLINE () #-} @@ -205,15 +215,11 @@ internalInnerSlice dim cutSz arr i = do -- [ 2 :. 0, 2 :. 1 ] -- -- @since 0.5.4 -outerSlices :: OuterSlice r ix e => Array r ix e -> Array D Ix1 (Elt r ix e) -outerSlices arr = makeArray Seq k (unsafeOuterSlice arr) +outerSlices :: + (Index ix, Index (Lower ix), Source r e) => Array r ix e -> Array D Ix1 (Array r (Lower ix) e) +outerSlices arr = makeArray (getComp arr) k (unsafeOuterSlice (setComp Seq arr) szL) where - (k, _) = unconsSz $ size arr --- TODO: move setComp to Load --- outerSlices arr = makeArray (getComp arr) k (unsafeOuterSlice arr') --- where --- arr' = setComp Seq arr --- (k, _) = unconsSz $ size arr + (k, szL) = unconsSz $ size arr {-# INLINE outerSlices #-} @@ -229,15 +235,10 @@ outerSlices arr = makeArray Seq k (unsafeOuterSlice arr) -- [ 0 :. 1, 1 :. 1, 2 :. 1 ] -- -- @since 0.5.4 -innerSlices :: InnerSlice r ix e => Array r ix e -> Array D Ix1 (Elt r ix e) -innerSlices arr = makeArray Seq k (unsafeInnerSlice arr sz) +innerSlices :: (Index ix, Source r e) => Array r ix e -> Array D Ix1 (Array D (Lower ix) e) +innerSlices arr = makeArray (getComp arr) k (unsafeInnerSlice (setComp Seq arr) szL) where - sz@(_, k) = unsnocSz $ size arr --- TODO: move setComp to Load --- innerSlices arr = makeArray (getComp arr) k (unsafeInnerSlice arr' sz) --- where --- arr' = setComp Seq arr --- sz@(_, k) = unsnocSz $ size arr + (szL, k) = unsnocSz $ size arr {-# INLINE innerSlices #-} -- | Create a delayed array of slices from within. Checks dimension at compile time. @@ -287,10 +288,10 @@ innerSlices arr = makeArray Seq k (unsafeInnerSlice arr sz) -- -- @since 0.5.4 withinSlices :: - (IsIndexDimension ix n, Slice r ix e) + (IsIndexDimension ix n, Index (Lower ix), Source r e) => Dimension n -> Array r ix e - -> Array D Ix1 (Elt r ix e) + -> Array D Ix1 (Array D (Lower ix) e) withinSlices dim = either throwImpossible id . withinSlicesM (fromDimension dim) {-# INLINE withinSlices #-} @@ -301,7 +302,11 @@ withinSlices dim = either throwImpossible id . withinSlicesM (fromDimension dim) -- /__Throws Exceptions__/: `IndexDimensionException` -- -- @since 0.5.4 -withinSlicesM :: (MonadThrow m, Slice r ix e) => Dim -> Array r ix e -> m (Array D Ix1 (Elt r ix e)) +withinSlicesM :: + (MonadThrow m, Index ix, Index (Lower ix), Source r e) + => Dim + -> Array r ix e + -> m (Array D Ix1 (Array D (Lower ix) e)) withinSlicesM dim arr = do (k, szl) <- pullOutSzM (size arr) dim cutSz <- insertSzM szl dim oneSz diff --git a/massiv/src/Data/Massiv/Array/Ops/Transform.hs b/massiv/src/Data/Massiv/Array/Ops/Transform.hs index 20f3deb9..fbbf3b4f 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Transform.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Transform.hs @@ -80,11 +80,12 @@ import Prelude as P hiding (concat, splitAt, traverse, mapM_, reverse, take, dro -- | Extract a sub-array from within a larger source array. Array that is being extracted must be -- fully encapsulated in a source array, otherwise `SizeSubregionException` will be thrown. -extractM :: (MonadThrow m, Extract r ix e) - => ix -- ^ Starting index - -> Sz ix -- ^ Size of the resulting array - -> Array r ix e -- ^ Source array - -> m (Array (R r) ix e) +extractM :: + (MonadThrow m, Index ix, Source r e) + => ix -- ^ Starting index + -> Sz ix -- ^ Size of the resulting array + -> Array r ix e -- ^ Source array + -> m (Array D ix e) extractM !sIx !newSz !arr | isSafeIndex sz1 sIx && isSafeIndex eIx1 sIx && isSafeIndex sz1 eIx = pure $ unsafeExtract sIx newSz arr @@ -99,11 +100,12 @@ extractM !sIx !newSz !arr -- are incorrect. -- -- @since 0.1.0 -extract' :: Extract r ix e - => ix -- ^ Starting index - -> Sz ix -- ^ Size of the resulting array - -> Array r ix e -- ^ Source array - -> Array (R r) ix e +extract' :: + (Index ix, Source r e) + => ix -- ^ Starting index + -> Sz ix -- ^ Size of the resulting array + -> Array r ix e -- ^ Source array + -> Array D ix e extract' sIx newSz = either throw id . extractM sIx newSz {-# INLINE extract' #-} @@ -112,22 +114,24 @@ extract' sIx newSz = either throw id . extractM sIx newSz -- the ending index. -- -- @since 0.3.0 -extractFromToM :: (MonadThrow m, Extract r ix e) => - ix -- ^ Starting index - -> ix -- ^ Index up to which elements should be extracted. - -> Array r ix e -- ^ Source array. - -> m (Array (R r) ix e) +extractFromToM :: + (MonadThrow m, Index ix, Source r e) + => ix -- ^ Starting index + -> ix -- ^ Index up to which elements should be extracted. + -> Array r ix e -- ^ Source array. + -> m (Array D ix e) extractFromToM sIx eIx = extractM sIx (Sz (liftIndex2 (-) eIx sIx)) {-# INLINE extractFromToM #-} -- | Same as `extractFromTo`, but throws an error on invalid indices. -- -- @since 0.2.4 -extractFromTo' :: Extract r ix e => - ix -- ^ Starting index - -> ix -- ^ Index up to which elmenets should be extracted. - -> Array r ix e -- ^ Source array. - -> Array (R r) ix e +extractFromTo' :: + (Index ix, Source r e) + => ix -- ^ Starting index + -> ix -- ^ Index up to which elmenets should be extracted. + -> Array r ix e -- ^ Source array. + -> Array D ix e extractFromTo' sIx eIx = extract' sIx $ Sz (liftIndex2 (-) eIx sIx) {-# INLINE extractFromTo' #-} @@ -630,11 +634,11 @@ stackSlicesM dim !arrsF = do -- ] -- >>> rows = outerSlices x -- >>> A.mapM_ print rows --- Array M Seq (Sz1 3) +-- Array P Seq (Sz1 3) -- [ 1, 2, 3 ] --- Array M Seq (Sz1 3) +-- Array P Seq (Sz1 3) -- [ 4, 5, 6 ] --- Array M Seq (Sz1 3) +-- Array P Seq (Sz1 3) -- [ 7, 8, 9 ] -- >>> stackOuterSlicesM rows :: IO (Matrix DL Int) -- Array DL Seq (Sz (3 :. 3)) @@ -670,11 +674,11 @@ stackOuterSlicesM = stackSlicesM (dimensions (Proxy :: Proxy ix)) -- ] -- >>> columns = innerSlices x -- >>> A.mapM_ print columns --- Array M Seq (Sz1 3) +-- Array D Seq (Sz1 3) -- [ 1, 4, 7 ] --- Array M Seq (Sz1 3) +-- Array D Seq (Sz1 3) -- [ 2, 5, 8 ] --- Array M Seq (Sz1 3) +-- Array D Seq (Sz1 3) -- [ 3, 6, 9 ] -- >>> stackInnerSlicesM columns :: IO (Matrix DL Int) -- Array DL Seq (Sz (3 :. 3)) @@ -700,11 +704,11 @@ stackInnerSlicesM = stackSlicesM 1 -- -- @since 0.3.0 splitAtM :: - (MonadThrow m, Extract r ix e) + (MonadThrow m, Index ix, Source r e) => Dim -- ^ Dimension along which to split -> Int -- ^ Index along the dimension to split at -> Array r ix e -- ^ Source array - -> m (Array (R r) ix e, Array (R r) ix e) + -> m (Array D ix e, Array D ix e) splitAtM dim i arr = do let Sz sz = size arr eIx <- setDimM sz dim i @@ -723,8 +727,8 @@ splitAtM dim i arr = do -- -- -- @since 0.1.0 -splitAt' :: Extract r ix e => - Dim -> Int -> Array r ix e -> (Array (R r) ix e, Array (R r) ix e) +splitAt' :: + (Index ix, Source r e) => Dim -> Int -> Array r ix e -> (Array D ix e, Array D ix e) splitAt' dim i arr = either throw id $ splitAtM dim i arr {-# INLINE splitAt' #-} @@ -733,12 +737,12 @@ splitAt' dim i arr = either throw id $ splitAtM dim i arr -- -- @since 0.3.5 splitExtractM :: - (MonadThrow m, Extract r ix e, Source (R r) e) + (MonadThrow m, Index ix, Source r e) => Dim -- ^ Dimension along which to do the extraction -> Ix1 -- ^ Start index along the dimension that needs to be extracted -> Sz Ix1 -- ^ Size of the extracted array along the dimension that it will be extracted -> Array r ix e - -> m (Array (R r) ix e, Array (R r) ix e, Array (R r) ix e) + -> m (Array D ix e, Array D ix e, Array D ix e) splitExtractM dim startIx1 (Sz extractSzIx1) arr = do let Sz szIx = size arr midStartIx <- setDimM zeroIndex dim startIx1 @@ -781,21 +785,16 @@ splitExtractM dim startIx1 (Sz extractSzIx1) arr = do -- -- @since 0.6.1 replaceSlice :: - ( MonadThrow m - , Extract r ix e - , Source (R r) e - , Load (R r) (Lower ix) e - , Resize (R r) - ) + (MonadThrow m, Source r e, Source r' e, Index ix, Index (Lower ix)) => Dim -> Ix1 - -> Array (R r) (Lower ix) e + -> Array r' (Lower ix) e -> Array r ix e -> m (Array DL ix e) replaceSlice dim i sl arr = do (l, m, r) <- splitExtractM dim i (SafeSz 1) arr m' <- resizeM (size m) sl - concatM dim [l, m', r] + concatM dim [l, delay m', r] {-# INLINE replaceSlice #-} @@ -828,13 +827,12 @@ replaceSlice dim i sl arr = do -- @since 0.6.1 replaceOuterSlice :: ( MonadThrow m - , Extract r ix e - , Source (R r) e - , Load (R r) (Lower ix) e - , Resize (R r) + , Index ix + , Source r e + , Load r (Lower ix) e ) => Ix1 - -> Array (R r) (Lower ix) e + -> Array r (Lower ix) e -> Array r ix e -> m (Array DL ix e) replaceOuterSlice i sl arr = replaceSlice (dimensions (size arr)) i sl arr @@ -866,7 +864,7 @@ replaceOuterSlice i sl arr = replaceSlice (dimensions (size arr)) i sl arr -- -- @since 0.3.5 deleteRegionM :: - (MonadThrow m, Extract r ix e, Source (R r) e) + (MonadThrow m, Index ix, Source r e) => Dim -- ^ Along which axis should the removal happen -> Ix1 -- ^ At which index to start dropping slices -> Sz Ix1 -- ^ Number of slices to drop @@ -898,7 +896,7 @@ deleteRegionM dim ix sz arr = do -- -- @since 0.3.5 deleteRowsM :: - (MonadThrow m, Extract r ix e, Source (R r) e, Index (Lower ix)) + (MonadThrow m, Index ix, Index (Lower ix), Source r e) => Ix1 -> Sz Ix1 -> Array r ix e @@ -927,7 +925,7 @@ deleteRowsM = deleteRegionM 2 -- -- @since 0.3.5 deleteColumnsM :: - (MonadThrow m, Extract r ix e, Source (R r) e) + (MonadThrow m, Index ix, Source r e) => Ix1 -> Sz Ix1 -> Array r ix e diff --git a/massiv/src/Data/Massiv/Array/Unsafe.hs b/massiv/src/Data/Massiv/Array/Unsafe.hs index c06c21cc..298c5b23 100644 --- a/massiv/src/Data/Massiv/Array/Unsafe.hs +++ b/massiv/src/Data/Massiv/Array/Unsafe.hs @@ -87,7 +87,7 @@ module Data.Massiv.Array.Unsafe , module Data.Massiv.Array.Stencil.Unsafe ) where -import Data.Massiv.Array.Delayed.Pull (D) +import Data.Massiv.Array.Delayed.Pull (D, unsafeExtract, unsafeSlice, unsafeInnerSlice) import Data.Massiv.Array.Delayed.Push (unsafeMakeLoadArray, unsafeMakeLoadArrayAdjusted) import Data.Massiv.Array.Manifest.Boxed import Data.Massiv.Array.Manifest.Primitive diff --git a/massiv/src/Data/Massiv/Core.hs b/massiv/src/Data/Massiv/Core.hs index b67a3eb1..a6c46611 100644 --- a/massiv/src/Data/Massiv/Core.hs +++ b/massiv/src/Data/Massiv/Core.hs @@ -14,15 +14,11 @@ module Data.Massiv.Core , MMatrix , Elt , Construct - , Load(R, loadArrayM, loadArrayWithSetM) + , Load(loadArrayM, loadArrayWithSetM) , Stream(..) , Source , Resize - , Extract , StrideLoad(..) - , Slice - , OuterSlice - , InnerSlice , Manifest , Mutable , Ragged diff --git a/massiv/src/Data/Massiv/Core/Common.hs b/massiv/src/Data/Massiv/Core/Common.hs index c3f50f26..a2bf1693 100644 --- a/massiv/src/Data/Massiv/Core/Common.hs +++ b/massiv/src/Data/Massiv/Core/Common.hs @@ -31,10 +31,6 @@ module Data.Massiv.Core.Common , Size(..) , Shape(..) , Resize(..) - , Extract(..) - , Slice(..) - , OuterSlice(..) - , InnerSlice(..) , Manifest(..) , Mutable(..) , Comp(..) @@ -58,7 +54,8 @@ module Data.Massiv.Core.Common , singleton -- * Size , elemsCount - , isNull + , isNotNull + , isEmpty , isNotEmpty , Sz(SafeSz) , LengthHint(..) @@ -151,7 +148,7 @@ type MMatrix s r e = MArray s r Ix2 e type family Elt r ix e :: * where Elt r Ix1 e = e - Elt r ix e = Array (R r) (Lower ix) e + Elt r ix e = Array r (Lower ix) e type family NestedStruct r ix e :: * @@ -256,7 +253,8 @@ data LengthHint deriving (Eq, Show) --- | A shape of an array. +-- | The shape of an array. It is different from `Size` in that it can be applicable to +-- non-square matrices and might not be available in constant time. -- -- @since 1.0.0 class Index ix => Shape r ix where @@ -265,8 +263,7 @@ class Index ix => Shape r ix where -- -- @since 1.0.0 linearSizeHint :: Array r ix e -> LengthHint - default linearSizeHint :: Size r => Array r ix e -> LengthHint - linearSizeHint = LengthExact . SafeSz . elemsCount + linearSizeHint = LengthExact . linearSize {-# INLINE linearSizeHint #-} -- | /O(n)/ - possibly iterate over the whole array before producing the answer @@ -296,20 +293,24 @@ class Index ix => Shape r ix where maxLinearSize = lengthHintUpperBound . linearSizeHint {-# INLINE maxLinearSize #-} - -- | /O(1)/ - Check if an array has no elements. + -- | /O(1)/ - Check whether an array is empty or not. -- -- ==== __Examples__ -- -- >>> import Data.Massiv.Array - -- >>> isEmpty $ range Seq (Ix2 10 20) (11 :. 21) + -- >>> isNull $ range Seq (Ix2 10 20) (11 :. 21) -- False - -- >>> isEmpty $ range Seq (Ix2 10 20) (10 :. 21) + -- >>> isNull $ range Seq (Ix2 10 20) (10 :. 21) + -- True + -- >>> isNull (empty :: Array D Ix5 Int) + -- True + -- >>> isNull $ sfromList [] -- True -- - -- @since 0.1.0 - isEmpty :: Array r ix e -> Bool - isEmpty = (0 ==) . linearSize - {-# INLINE isEmpty #-} + -- @since 1.0.0 + isNull :: Array r ix e -> Bool + isNull = (0 ==) . linearSize + {-# INLINE isNull #-} lengthHintUpperBound :: LengthHint -> Maybe Sz1 @@ -336,14 +337,8 @@ class Size r => Resize r where -class (Size r, Index ix) => Extract r ix e where - -- | /O(1)/ - Extract a portion of an array. Staring index and new size are - -- not validated. - unsafeExtract :: ix -> Sz ix -> Array r ix e -> Array (R r) ix e - - -- | Arrays that can be used as source to practically any manipulation function. -class (Strategy r, Size r) => Source r e where +class (Strategy r, Resize r) => Source r e where {-# MINIMAL (unsafeIndex|unsafeLinearIndex), unsafeLinearSlice #-} -- | Lookup element in the array. No bounds check is performed and access of @@ -364,16 +359,22 @@ class (Strategy r, Size r) => Source r e where unsafeLinearIndex !arr = unsafeIndex arr . fromLinearIndex (size arr) {-# INLINE unsafeLinearIndex #-} + + -- | /O(1)/ - Take a slice out of an array from the outside + unsafeOuterSlice :: (Index ix, Index (Lower ix)) => + Array r ix e -> Sz (Lower ix) -> Int -> Array r (Lower ix) e + unsafeOuterSlice arr sz i = unsafeResize sz $ unsafeLinearSlice i (toLinearSz sz) arr + {-# INLINE unsafeOuterSlice #-} + -- | /O(1)/ - Source arrays also give us ability to look at their linear slices in -- constant time -- -- @since 0.5.0 unsafeLinearSlice :: Index ix => Ix1 -> Sz1 -> Array r ix e -> Array r Ix1 e + -- | Any array that can be computed and loaded into memory class (Strategy r, Shape r ix) => Load r ix e where - type family R r :: * - type instance R r = r {-# MINIMAL (loadArrayM | loadArrayWithSetM) #-} -- | Load an array into memory. @@ -489,17 +490,6 @@ class (Size r, Load r ix e) => StrideLoad r ix e where --only ragged arrays (L, LN and DS don't count, since they don't have constant time --slicing anyways) -class (Size r, Load r ix e) => OuterSlice r ix e where - -- | /O(1)/ - Take a slice out of an array from the outside - unsafeOuterSlice :: Array r ix e -> Int -> Elt r ix e - -class (Size r, Load r ix e) => InnerSlice r ix e where - unsafeInnerSlice :: Array r ix e -> (Sz (Lower ix), Sz Int) -> Int -> Elt r ix e - -class (Size r, Load r ix e) => Slice r ix e where - unsafeSlice :: MonadThrow m => Array r ix e -> ix -> Sz ix -> Dim -> m (Elt r ix e) - - -- | Manifest arrays are backed by actual memory and values are looked up versus -- computed as it is with delayed arrays. Because of this fact indexing functions -- @(`!`)@, @(`!?`)@, etc. are constrained to manifest arrays only. @@ -853,7 +843,7 @@ infixl 4 !, !?, ?? -- ] -- ) -- >>> ma ??> 1 --- Just (Array M Seq (Sz (1 :. 3)) +-- Just (Array U Seq (Sz (1 :. 3)) -- [ [ 4, 5, 6 ] -- ] -- ) @@ -1008,18 +998,34 @@ imapM_ f !arr = -- ==== __Examples__ -- -- >>> import Data.Massiv.Array --- >>> isNotEmpty (singleton 1 :: Array D Ix2 Int) +-- >>> isNotNull (singleton 1 :: Array D Ix2 Int) -- True --- >>> isNotEmpty (empty :: Array D Ix2 Int) +-- >>> isNotNull (empty :: Array D Ix2 Int) -- False -- -- @since 0.5.1 -isNotEmpty :: Shape r ix => Array r ix e -> Bool -isNotEmpty = not . isEmpty -{-# INLINE isNotEmpty #-} +isNotNull :: Shape r ix => Array r ix e -> Bool +isNotNull = not . isNull +{-# INLINE isNotNull #-} +-- | /O(1)/ - Check if array has elements. +-- +-- ==== __Examples__ +-- +-- >>> import Data.Massiv.Array +-- >>> isEmpty (singleton 1 :: Array D Ix2 Int) +-- False +-- >>> isEmpty (empty :: Array D Ix2 Int) +-- True +-- +-- @since 1.0.0 +isEmpty :: (Index ix, Size r) => Array r ix e -> Bool +isEmpty = (==0) . elemsCount +{-# INLINE isEmpty #-} + + -- | /O(1)/ - Check if array has elements. -- -- ==== __Examples__ @@ -1030,10 +1036,10 @@ isNotEmpty = not . isEmpty -- >>> isNotEmpty (empty :: Array D Ix2 Int) -- False -- --- @since 0.5.1 -isNull :: (Index ix, Size r) => Array r ix e -> Bool -isNull = (==0) . elemsCount -{-# INLINE isNull #-} +-- @since 1.0.0 +isNotEmpty :: (Index ix, Size r) => Array r ix e -> Bool +isNotEmpty = not . isEmpty +{-# INLINE isNotEmpty #-} -- | /O(1)/ - Get the number of elements in the array. diff --git a/massiv/src/Data/Massiv/Core/List.hs b/massiv/src/Data/Massiv/Core/List.hs index d6fbf0c6..280872de 100644 --- a/massiv/src/Data/Massiv/Core/List.hs +++ b/massiv/src/Data/Massiv/Core/List.hs @@ -125,8 +125,8 @@ instance Shape LN Ix1 where {-# INLINE linearSize #-} linearSizeHint = lengthHintList . unList {-# INLINE linearSizeHint #-} - isEmpty = null . unList - {-# INLINE isEmpty #-} + isNull = null . unList + {-# INLINE isNull #-} outerSize = linearSize {-# INLINE outerSize #-} @@ -135,8 +135,8 @@ instance Shape L Ix1 where {-# INLINE linearSize #-} linearSizeHint = linearSizeHint . lData {-# INLINE linearSizeHint #-} - isEmpty = isEmpty . lData - {-# INLINE isEmpty #-} + isNull = isNull . lData + {-# INLINE isNull #-} outerSize = linearSize {-# INLINE outerSize #-} @@ -145,8 +145,8 @@ instance Shape LN Ix2 where {-# INLINE linearSize #-} linearSizeHint = lengthHintList . unList {-# INLINE linearSizeHint #-} - isEmpty = null . unList - {-# INLINE isEmpty #-} + isNull = null . unList + {-# INLINE isNull #-} outerSize arr = case unList arr of [] -> zeroSz @@ -158,8 +158,8 @@ instance Shape L Ix2 where {-# INLINE linearSize #-} linearSizeHint = linearSizeHint . lData {-# INLINE linearSizeHint #-} - isEmpty = isEmpty . lData - {-# INLINE isEmpty #-} + isNull = isNull . lData + {-# INLINE isNull #-} outerSize = outerSize . lData {-# INLINE outerSize #-} @@ -168,8 +168,8 @@ instance (Shape LN (Ix (n - 1)), Index (IxN n)) => Shape LN (IxN n) where {-# INLINE linearSize #-} linearSizeHint = lengthHintList . unList {-# INLINE linearSizeHint #-} - isEmpty = null . unList - {-# INLINE isEmpty #-} + isNull = null . unList + {-# INLINE isNull #-} outerSize arr = case unList arr of [] -> zeroSz @@ -182,8 +182,8 @@ instance (Index (IxN n), Shape LN (IxN n)) => Shape L (IxN n) where {-# INLINE linearSize #-} linearSizeHint = linearSizeHint . lData {-# INLINE linearSizeHint #-} - isEmpty = isEmpty . lData - {-# INLINE isEmpty #-} + isNull = isNull . lData + {-# INLINE isNull #-} outerSize = outerSize . lData {-# INLINE outerSize #-} @@ -217,7 +217,7 @@ instance Ragged L Ix1 e where case unconsR xs' of Nothing -> return $! throw (DimTooShortException sz (outerLength xs)) Just (y, ys) -> uWrite i y >> return ys - unless (isEmpty leftOver) (return $! throw DimTooLongException) + unless (isNull leftOver) (return $! throw DimTooLongException) {-# INLINE loadRagged #-} raggedFormat f _ arr = L.concat $ "[ " : L.intersperse ", " (map f (coerce (lData arr))) ++ [" ]"] @@ -263,7 +263,7 @@ instance Ragged L Ix2 e where let (k, szL) = unconsSz sz step = totalElem szL isZero = totalElem sz == 0 - when (isZero && not (isEmpty (flattenRagged xs))) (return $! throw DimTooLongException) + when (isZero && isNotNull (flattenRagged xs)) (return $! throw DimTooLongException) unless isZero $ do leftOver <- loopM start (< end) (+ step) xs $ \i zs -> @@ -272,7 +272,7 @@ instance Ragged L Ix2 e where Just (y, ys) -> do _ <- loadRagged using uWrite i (i + step) szL y return ys - unless (isEmpty leftOver) (return $! throw DimTooLongException) + unless (isNull leftOver) (return $! throw DimTooLongException) {-# INLINE loadRagged #-} raggedFormat f sep (LArray comp xs) = showN (\s y -> raggedFormat f s (LArray comp y :: Array L Ix1 e)) sep (coerce xs) @@ -304,7 +304,7 @@ instance (Shape L (IxN n), Shape LN (Ix (n - 1)), Ragged L (Ix (n - 1)) e) => let (k, szL) = unconsSz sz step = totalElem szL isZero = totalElem sz == 0 - when (isZero && not (isEmpty (flattenRagged xs))) (return $! throw DimTooLongException) + when (isZero && isNotNull (flattenRagged xs)) (return $! throw DimTooLongException) unless isZero $ do leftOver <- loopM start (< end) (+ step) xs $ \i zs -> @@ -313,7 +313,7 @@ instance (Shape L (IxN n), Shape LN (Ix (n - 1)), Ragged L (Ix (n - 1)) e) => Just (y, ys) -> do _ <- loadRagged using uWrite i (i + step) szL y return ys - unless (isEmpty leftOver) (return $! throw DimTooLongException) + unless (isNull leftOver) (return $! throw DimTooLongException) {-# INLINE loadRagged #-} raggedFormat f sep (LArray comp xs) = showN (\s y -> raggedFormat f s (LArray comp y :: Array L (Ix (n - 1)) e)) sep (coerce xs) diff --git a/massiv/src/Data/Massiv/Vector.hs b/massiv/src/Data/Massiv/Vector.hs index 5a3c3cde..91542e89 100644 --- a/massiv/src/Data/Massiv/Vector.hs +++ b/massiv/src/Data/Massiv/Vector.hs @@ -17,7 +17,8 @@ module Data.Massiv.Vector , slength , maxLinearSize , size - , snull + , isNull + , isNotNull -- *** Indexing , (!?) , (!) @@ -348,38 +349,6 @@ slength v = _ -> Nothing {-# INLINE slength #-} --- | /O(1)/ - Check whether a `Stream` array is empty or not. It only looks at the exact size --- (i.e. `slength`), if it is available, otherwise checks if there is at least one element --- in a stream. --- --- /Related/: `isEmpty`, `isNotEmpty` --- --- ==== __Examples__ --- --- >>> snull sempty --- True --- >>> snull (empty :: Array D Ix5 Int) --- True --- >>> snull $ ssingleton "A Vector with a single String element" --- False --- >>> snull $ sfromList [] --- True --- >>> snull $ sfromList [1 :: Int ..] --- False --- --- /__Similar__/: --- --- [@Data.Foldable.`Data.Foldable.null`@] List fusion is also broken with a check for --- emptiness, unless there are no other consumers of the list. --- --- [@Data.Vector.Generic.`Data.Vector.Generic.null`@] Same as with --- `Data.Vector.Generic.length`, unless it is the only operation applied to the vector it --- will break fusion and will result in the vector being fully materialized in memory. --- --- @since 0.5.0 -snull :: Load r ix e => Array r ix e -> Bool -snull = isEmpty -{-# INLINE snull #-} -------------- -- Indexing -- From ab3ab09b7a57c53597f513b9c4c4b31a95088016 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sat, 17 Apr 2021 02:15:21 +0300 Subject: [PATCH 12/65] Get benchmarks to compile with new version --- massiv-bench/bench/Concat.hs | 4 ++-- massiv-bench/bench/Grid.hs | 6 ++--- massiv-bench/bench/Mutable.hs | 2 +- massiv-bench/src/Data/Massiv/Bench/Common.hs | 2 +- massiv-bench/src/Data/Massiv/Bench/Matrix.hs | 24 ++++++++------------ massiv-bench/src/Data/Massiv/Bench/Vector.hs | 11 ++++----- massiv/src/Data/Massiv/Core.hs | 2 ++ massiv/src/Data/Massiv/Core/Common.hs | 5 ++-- 8 files changed, 26 insertions(+), 30 deletions(-) diff --git a/massiv-bench/bench/Concat.hs b/massiv-bench/bench/Concat.hs index ca2af22d..117ec66a 100644 --- a/massiv-bench/bench/Concat.hs +++ b/massiv-bench/bench/Concat.hs @@ -39,7 +39,7 @@ main = do ] concatMutableM :: - forall r' r ix e . (Load r' ix e, Mutable r ix e) + forall r' r ix e . (Size r', Load r' ix e, Mutable r e) => [Array r' ix e] -> IO (Array r ix e) concatMutableM arrsF = @@ -68,7 +68,7 @@ concatMutableM arrsF = {-# INLINE concatMutableM #-} concatNewM :: - forall ix e r. (Index ix, Mutable r ix e) + forall ix e r. (Index ix, Mutable r e) => [Array r ix e] -> IO (Array r ix e) concatNewM arrsF = diff --git a/massiv-bench/bench/Grid.hs b/massiv-bench/bench/Grid.hs index f74913a8..555bafd9 100644 --- a/massiv-bench/bench/Grid.hs +++ b/massiv-bench/bench/Grid.hs @@ -12,7 +12,7 @@ import Prelude as P -- | Scale the array, negate values and create an array with a grid. -zoomWithGridD :: Manifest r Ix2 e => e -> Int -> Array r Ix2 e -> Array D Ix2 e +zoomWithGridD :: Manifest r e => e -> Int -> Matrix r e -> Matrix D e zoomWithGridD gridVal zoomFactor arr = A.makeArray (getComp arr) sz' getNewElt where k = zoomFactor + 1 @@ -25,7 +25,7 @@ zoomWithGridD gridVal zoomFactor arr = A.makeArray (getComp arr) sz' getNewElt {-# INLINE zoomWithGridD #-} zoomWithGridL :: - Source r ix e + (Index ix, Source r e) => e -- ^ Value to use for the grid -> Stride ix -- ^ Scaling factor -> Array r ix e -- ^ Source array @@ -44,7 +44,7 @@ zoomWithGridL gridVal (Stride zoomFactor) arr = -- | Scale the array, negate values and create an array with a grid. -zoomWithGridL' :: Source r Ix2 e => e -> Int -> Array r Ix2 e -> Array DL Ix2 e +zoomWithGridL' :: Source r e => e -> Int -> Matrix r e -> Matrix DL e zoomWithGridL' gridVal zoomFactor arr = makeLoadArrayS newSz gridVal $ \writeElement -> do A.iforM_ arr $ \ix e -> do diff --git a/massiv-bench/bench/Mutable.hs b/massiv-bench/bench/Mutable.hs index 77bb30a9..35686b5e 100644 --- a/massiv-bench/bench/Mutable.hs +++ b/massiv-bench/bench/Mutable.hs @@ -20,7 +20,7 @@ main = do mkBench :: - forall r. (Construct r Ix2 Double, Mutable r Ix2 Double) + forall r. (Construct r Ix2 Double, Mutable r Double) => Sz2 -> r -> IO [Benchmark] diff --git a/massiv-bench/src/Data/Massiv/Bench/Common.hs b/massiv-bench/src/Data/Massiv/Bench/Common.hs index 90de7d7c..6c483e7a 100644 --- a/massiv-bench/src/Data/Massiv/Bench/Common.hs +++ b/massiv-bench/src/Data/Massiv/Bench/Common.hs @@ -18,7 +18,7 @@ stdGen = mkStdGen 2020 showsType :: forall t . Typeable t => ShowS showsType = showsTypeRep (typeRep (Proxy :: Proxy t)) -makeRandomArray :: (Mutable r ix e, Random e) => Sz ix -> IO (Array r ix e) +makeRandomArray :: (Index ix, Mutable r e, Random e) => Sz ix -> IO (Array r ix e) makeRandomArray sz = do gen <- newStdGen pure $! snd $ randomArrayS gen sz random diff --git a/massiv-bench/src/Data/Massiv/Bench/Matrix.hs b/massiv-bench/src/Data/Massiv/Bench/Matrix.hs index 64286856..81900e54 100644 --- a/massiv-bench/src/Data/Massiv/Bench/Matrix.hs +++ b/massiv-bench/src/Data/Massiv/Bench/Matrix.hs @@ -35,7 +35,7 @@ bMxMsize = Sz2 m n -> Sz2 n m -randomMxM :: (Mutable r Ix2 e, Random e) => MxM r e +randomMxM :: (Mutable r e, Random e) => MxM r e randomMxM = case randomArrayS stdGen aMxMsize random of (g, a) -> MxM {aMxM = a, bMxM = snd $ randomArrayS g bMxMsize random} @@ -50,7 +50,7 @@ instance NFData (Matrix r e) => NFData (MxM r e) where rnf (MxM a b) = a `deepseq` b `deepseq` () -showSizeMxM :: Load r Ix2 e => MxM r e -> String +showSizeMxM :: Size r => MxM r e -> String showSizeMxM MxM {..} = show m1 <> "x" <> show n1 <> " X " <> show m2 <> "x" <> show n2 where Sz2 m1 n1 = size aMxM @@ -58,7 +58,7 @@ showSizeMxM MxM {..} = show m1 <> "x" <> show n1 <> " X " <> show m2 <> "x" <> s benchMxM :: - forall r e. (Typeable r, Typeable e, Numeric r e, Mutable r Ix2 e) + forall r e. (Typeable r, Typeable e, Load r Ix1 e, Load r Ix2 e, Numeric r e, Mutable r e) => MxM r e -> Benchmark benchMxM mxm@MxM {..} = @@ -88,12 +88,12 @@ bMxVsize = case aMxVsize of Sz2 _ n -> Sz1 n -randomMxV :: (Mutable r Ix2 e, Mutable r Ix1 e, Random e) => MxV r e +randomMxV :: (Mutable r e, Random e) => MxV r e randomMxV = case randomArrayS stdGen aMxVsize random of (g, a) -> MxV {aMxV = a, bMxV = snd $ randomArrayS g bMxVsize random} -showSizeMxV :: (Load r Ix1 e, Load r Ix2 e) => MxV r e -> String +showSizeMxV :: Size r => MxV r e -> String showSizeMxV MxV {..} = show m1 <> "x" <> show n1 <> " X " <> show n <> "x1" where Sz2 m1 n1 = size aMxV @@ -101,7 +101,7 @@ showSizeMxV MxV {..} = show m1 <> "x" <> show n1 <> " X " <> show n <> "x1" benchMxV :: - forall r e. (Typeable r, Typeable e, Numeric r e, Mutable r Ix1 e, Mutable r Ix2 e) + forall r e. (Typeable r, Typeable e, Numeric r e, Mutable r e) => MxV r e -> Benchmark benchMxV mxv@MxV {..} = @@ -139,26 +139,20 @@ aVxMsize = bVxMsize :: Sz2 bVxMsize = Sz2 5000 8000 -showSizeVxM :: (Load r Ix1 e, Load r Ix2 e) => VxM r e -> String +showSizeVxM :: Size r => VxM r e -> String showSizeVxM VxM {..} = "1x" <> show n <> " X " <> show m2 <> "x" <> show n2 where Sz1 n = size aVxM Sz2 m2 n2 = size bVxM -randomVxM :: (Mutable r Ix2 e, Mutable r Ix1 e, Random e) => VxM r e +randomVxM :: (Mutable r e, Random e) => VxM r e randomVxM = case randomArrayS stdGen aVxMsize random of (g, a) -> VxM {aVxM = a, bVxM = snd $ randomArrayS g bVxMsize random} benchVxM :: - forall r e. - ( Typeable r - , Typeable e - , Numeric r e - , Mutable r Ix1 e - , Mutable r Ix2 e - ) + forall r e. (Typeable r, Typeable e, Load r Ix1 e, Load r Ix2 e, Numeric r e, Mutable r e) => VxM r e -> Benchmark benchVxM mxv@VxM {..} = diff --git a/massiv-bench/src/Data/Massiv/Bench/Vector.hs b/massiv-bench/src/Data/Massiv/Bench/Vector.hs index c374e13c..7733283f 100644 --- a/massiv-bench/src/Data/Massiv/Bench/Vector.hs +++ b/massiv-bench/src/Data/Massiv/Bench/Vector.hs @@ -17,7 +17,6 @@ import Control.DeepSeq import Criterion.Main import Data.Massiv.Array import Data.Massiv.Bench.Common -import Data.Massiv.Bench.Matrix import Data.Typeable import System.Random @@ -25,13 +24,13 @@ v1size :: Sz1 v1size = Sz1 1000000 -randomV1 :: (Mutable r Ix1 e, Random e) => Vector r e +randomV1 :: (Mutable r e, Random e) => Vector r e randomV1 = snd $ randomArrayS stdGen v1size random benchV1 :: - forall r e. (Typeable r, Typeable e, Construct r Ix1 e, Source r Ix1 e, Floating e, Numeric r e) + forall r e. (Typeable r, Typeable e, Source r e, Floating e, Numeric r e) => Vector r e -> Benchmark benchV1 v = @@ -64,12 +63,12 @@ bVxVsize :: Sz1 bVxVsize = aVxVsize -randomVxV :: (Mutable r Ix1 e, Random e) => VxV r e +randomVxV :: (Mutable r e, Random e) => VxV r e randomVxV = case randomArrayS stdGen aVxVsize random of (g, a) -> VxV {aVxV = a, bVxV = snd $ randomArrayS g bVxVsize random} -showSizeVxV :: Load r Ix1 e => VxV r e -> String +showSizeVxV :: Size r => VxV r e -> String showSizeVxV VxV {..} = show n1 <> " X " <> show n2 where Sz1 n1 = size aVxV @@ -77,7 +76,7 @@ showSizeVxV VxV {..} = show n1 <> " X " <> show n2 benchVxV :: - forall r e. (Typeable r, Typeable e, Numeric r e, Mutable r Ix1 e) + forall r e. (Typeable r, Typeable e, Numeric r e, Mutable r e) => VxV r e -> Benchmark benchVxV vxv@VxV {..} = diff --git a/massiv/src/Data/Massiv/Core.hs b/massiv/src/Data/Massiv/Core.hs index a6c46611..e044fd2c 100644 --- a/massiv/src/Data/Massiv/Core.hs +++ b/massiv/src/Data/Massiv/Core.hs @@ -17,7 +17,9 @@ module Data.Massiv.Core , Load(loadArrayM, loadArrayWithSetM) , Stream(..) , Source + , Size , Resize + , Shape , StrideLoad(..) , Manifest , Mutable diff --git a/massiv/src/Data/Massiv/Core/Common.hs b/massiv/src/Data/Massiv/Core/Common.hs index a2bf1693..ff1501a1 100644 --- a/massiv/src/Data/Massiv/Core/Common.hs +++ b/massiv/src/Data/Massiv/Core/Common.hs @@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} +{-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} @@ -321,7 +322,7 @@ lengthHintUpperBound = \case {-# INLINE lengthHintUpperBound #-} -class Size r where +class (forall ix. Index ix => Shape r ix) => Size r where -- | Get the exact size of an immutabe array. Most of the time will produce the size in -- constant time, except for `DS` representation, which could result in evaluation of @@ -498,7 +499,7 @@ class (Resize r, Source r e) => Manifest r e where unsafeLinearIndexM :: Index ix => Array r ix e -> Int -> e -class Manifest r e => Mutable r e where +class (forall ix . Index ix => Construct r ix e, Manifest r e) => Mutable r e where data MArray s r ix e :: * -- | Get the size of a mutable array. From f4036ace9b4906c060f6d2ed8ffeb1f322287315 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Mon, 19 Apr 2021 22:44:51 +0300 Subject: [PATCH 13/65] Add random as a dependency --- massiv-test/src/Test/Massiv/Array/Numeric.hs | 2 -- massiv-test/src/Test/Massiv/Utils.hs | 4 +-- massiv/massiv.cabal | 1 + .../Data/Massiv/Array/Manifest/Internal.hs | 4 +-- massiv/src/Data/Massiv/Array/Ops/Construct.hs | 33 +++++++++++++++++-- massiv/src/Data/Massiv/Core/Common.hs | 5 ++- stack.yaml | 5 ++- 7 files changed, 42 insertions(+), 12 deletions(-) diff --git a/massiv-test/src/Test/Massiv/Array/Numeric.hs b/massiv-test/src/Test/Massiv/Array/Numeric.hs index 648db654..0b793744 100644 --- a/massiv-test/src/Test/Massiv/Array/Numeric.hs +++ b/massiv-test/src/Test/Massiv/Array/Numeric.hs @@ -55,7 +55,6 @@ prop_MatrixVectorMultiply :: forall r e. ( Numeric r e , Mutable r e - , Source r e , Construct r Ix1 e , Eq e , Show e @@ -231,7 +230,6 @@ mutableNumericSpec :: , Mutable r e , Construct r Ix1 e , Construct r Ix2 e - , Source r e , Eq e , Show e , Function e diff --git a/massiv-test/src/Test/Massiv/Utils.hs b/massiv-test/src/Test/Massiv/Utils.hs index b004fc6c..55d682de 100644 --- a/massiv-test/src/Test/Massiv/Utils.hs +++ b/massiv-test/src/Test/Massiv/Utils.hs @@ -107,13 +107,13 @@ instance Function Word where -- | Convert an hspec Expectation to a quickcheck Property. -- -- @since 1.5.0 -expectProp :: HasCallStack => Expectation -> Property +expectProp :: Expectation -> Property expectProp = monadicIO . run -- | Convert a Testable to a quickcheck Property. Works well with hspec expectations as well -- -- @since 1.7.0 -propIO :: (HasCallStack, Testable a) => IO a -> Property +propIO :: (Testable a) => IO a -> Property propIO action = monadicIO $ run action diff --git a/massiv/massiv.cabal b/massiv/massiv.cabal index 58de2b30..9c3669d2 100644 --- a/massiv/massiv.cabal +++ b/massiv/massiv.cabal @@ -83,6 +83,7 @@ library , exceptions , scheduler >= 1.5.0 , primitive + , random , unliftio-core , vector diff --git a/massiv/src/Data/Massiv/Array/Manifest/Internal.hs b/massiv/src/Data/Massiv/Array/Manifest/Internal.hs index f3f31ab3..c9fee564 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Internal.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Internal.hs @@ -290,9 +290,9 @@ computeProxy _ = compute -- resulting type is the same as the input. -- -- @since 0.1.0 -computeSource :: forall r ix e r' . (Mutable r e, Load r' ix e, Source r' e) +computeSource :: forall r ix e r' . (Mutable r e, Source r' e, Index ix) => Array r' ix e -> Array r ix e -computeSource arr = maybe (compute arr) (\Refl -> arr) (eqT :: Maybe (r' :~: r)) +computeSource arr = maybe (compute $ delay arr) (\Refl -> arr) (eqT :: Maybe (r' :~: r)) {-# INLINE computeSource #-} diff --git a/massiv/src/Data/Massiv/Array/Ops/Construct.hs b/massiv/src/Data/Massiv/Array/Ops/Construct.hs index 7e607fd3..470edda3 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Construct.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Construct.hs @@ -74,6 +74,7 @@ import Data.Massiv.Array.Delayed.Push import Data.Massiv.Array.Mutable import Data.Massiv.Core.Common import Prelude hiding (enumFromTo, replicate) +import System.Random.Stateful -- | Just like `makeArray` but with ability to specify the result representation as an -- argument. Note the `Data.Massiv.Array.U`nboxed type constructor in the below example. @@ -294,7 +295,10 @@ iunfoldlS_ sz f acc0 = DLArray {dlComp = Seq, dlSize = sz, dlLoad = load} -- , [ 9.308278528094238e-2, 0.7200934018606843, 0.23173694193083583 ] -- ] -- --- @since 0.3.3 +-- @since 1.0.0 +-- | Helper for generating random arrays +-- +-- @since 1.0.0 randomArray :: forall ix e g. Index ix => g -- ^ Initial random value generator @@ -329,6 +333,31 @@ randomArray gen splitGen nextRandom comp sz = unsafeMakeLoadArray comp sz Nothin void $ loopM slackStartAt (< totalLength + startAt) (+ 1) genForSlack writeRandom {-# INLINE randomArray #-} + +-- | Generate a random array where all elements are sampled from a uniform distribution. +-- +-- @since 1.0.0 +uniformArray :: + forall ix e g. (Index ix, RandomGen g, Uniform e) + => g -- ^ Initial random value generator + -> Comp -- ^ Computation strategy. + -> Sz ix -- ^ Resulting size of the array. + -> Array DL ix e +uniformArray gen = randomArray gen split uniform + +-- | Same as `uniformArray`, but will generate values in a supplied range. +-- +-- @since 1.0.0 +uniformRangeArray :: + forall ix e g. (Index ix, RandomGen g, UniformRange e) + => g -- ^ Initial random value generator + -> (e, e) + -> Comp -- ^ Computation strategy. + -> Sz ix -- ^ Resulting size of the array. + -> Array DL ix e +uniformRangeArray gen range = randomArray gen split (uniformR range) + + -- | Similar to `randomArray` but performs generation sequentially, which means it doesn't -- require splitability property. Another consequence is that it returns the new generator -- together with /manifest/ array of random values. @@ -385,7 +414,7 @@ randomArrayS gen sz nextRandom = -- -- ==== __Examples__ -- --- In the example below we take a stateful random generator from +-- In the example below we take a stateful random number generator from -- [wmc-random](https://www.stackage.org/package/mwc-random), which is not thread safe, -- and safely parallelize it by giving each thread it's own generator: -- diff --git a/massiv/src/Data/Massiv/Core/Common.hs b/massiv/src/Data/Massiv/Core/Common.hs index ff1501a1..564611b4 100644 --- a/massiv/src/Data/Massiv/Core/Common.hs +++ b/massiv/src/Data/Massiv/Core/Common.hs @@ -1,6 +1,5 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} -{-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} @@ -322,7 +321,7 @@ lengthHintUpperBound = \case {-# INLINE lengthHintUpperBound #-} -class (forall ix. Index ix => Shape r ix) => Size r where +class Size r where -- | Get the exact size of an immutabe array. Most of the time will produce the size in -- constant time, except for `DS` representation, which could result in evaluation of @@ -499,7 +498,7 @@ class (Resize r, Source r e) => Manifest r e where unsafeLinearIndexM :: Index ix => Array r ix e -> Int -> e -class (forall ix . Index ix => Construct r ix e, Manifest r e) => Mutable r e where +class (Manifest r e) => Mutable r e where data MArray s r ix e :: * -- | Get the size of a mutable array. diff --git a/stack.yaml b/stack.yaml index ff9649ba..8e163472 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-16.20 +resolver: lts-16.31 packages: - 'massiv/' - 'massiv-test/' @@ -7,3 +7,6 @@ extra-deps: - primitive-0.7.1.0 - pvar-1.0.0.0@sha256:3d4a6855b0960baee78f6956f082eb8aa1cede52d2955b7faef186d1133f7964,1893 - scheduler-1.5.0 +- random-1.2.0@sha256:5ca8674e95c46c7eb90f520c26aea22d403625c97697275434afba66ebd32b05,5897 +- splitmix-0.1.0.3@sha256:fc3aae74c467f4b608050bef53aec17904a618731df9407e655d8f3bf8c32d5c,6049 +- QuickCheck-2.14.1@sha256:01e46d7b0a8d3148288ec977625f62d5516ebb5031a50c63f0453863301b4a79,7736 From f986b40f6748c83b0cd38049ef950e4a10a9e98a Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Thu, 22 Apr 2021 01:49:57 +0300 Subject: [PATCH 14/65] Consolidate `Construct` class into `Load` and get rid of `M` representation --- massiv-test/CHANGELOG.md | 4 + massiv-test/src/Test/Massiv/Array/Mutable.hs | 6 +- massiv-test/src/Test/Massiv/Array/Numeric.hs | 10 +- massiv-test/src/Test/Massiv/Core/Common.hs | 12 +- massiv-test/src/Test/Massiv/Core/Mutable.hs | 2 +- .../Test/Massiv/Array/Manifest/VectorSpec.hs | 2 +- .../tests/Test/Massiv/Array/ManifestSpec.hs | 7 +- .../tests/Test/Massiv/Array/MutableSpec.hs | 2 +- .../tests/Test/Massiv/Array/Ops/SliceSpec.hs | 2 +- .../tests/Test/Massiv/Array/Ops/SortSpec.hs | 2 +- .../Test/Massiv/Array/Ops/TransformSpec.hs | 8 +- massiv-test/tests/Test/Massiv/ArraySpec.hs | 20 ++- .../tests/Test/Massiv/Core/ListSpec.hs | 4 - massiv/CHANGELOG.md | 2 + .../Data/Massiv/Array/Delayed/Interleaved.hs | 7 +- massiv/src/Data/Massiv/Array/Delayed/Pull.hs | 7 +- massiv/src/Data/Massiv/Array/Delayed/Push.hs | 22 ++- .../src/Data/Massiv/Array/Delayed/Stream.hs | 13 +- .../src/Data/Massiv/Array/Delayed/Windowed.hs | 13 +- massiv/src/Data/Massiv/Array/Manifest.hs | 11 +- .../src/Data/Massiv/Array/Manifest/Boxed.hs | 37 +++-- .../Data/Massiv/Array/Manifest/Internal.hs | 131 +----------------- massiv/src/Data/Massiv/Array/Manifest/List.hs | 2 +- .../Data/Massiv/Array/Manifest/Primitive.hs | 13 +- .../Data/Massiv/Array/Manifest/Storable.hs | 13 +- .../src/Data/Massiv/Array/Manifest/Unboxed.hs | 13 +- .../src/Data/Massiv/Array/Manifest/Vector.hs | 4 +- .../src/Data/Massiv/Array/Numeric/Integral.hs | 2 +- massiv/src/Data/Massiv/Array/Ops/Construct.hs | 32 +++-- massiv/src/Data/Massiv/Core.hs | 1 - massiv/src/Data/Massiv/Core/Common.hs | 116 ++++++++-------- massiv/src/Data/Massiv/Core/List.hs | 80 +++-------- massiv/src/Data/Massiv/Core/Operations.hs | 4 +- 33 files changed, 206 insertions(+), 398 deletions(-) diff --git a/massiv-test/CHANGELOG.md b/massiv-test/CHANGELOG.md index afadae5c..5bf2b4df 100644 --- a/massiv-test/CHANGELOG.md +++ b/massiv-test/CHANGELOG.md @@ -1,3 +1,7 @@ +# 1.0.0 + +* Support for massiv-1.0.0.0 + # 0.1.7 * Add `propIO` diff --git a/massiv-test/src/Test/Massiv/Array/Mutable.hs b/massiv-test/src/Test/Massiv/Array/Mutable.hs index ab72f11d..d77fe187 100644 --- a/massiv-test/src/Test/Massiv/Array/Mutable.hs +++ b/massiv-test/src/Test/Massiv/Array/Mutable.hs @@ -50,7 +50,7 @@ prop_GenerateArray :: ( Show (Array r ix e) , Eq (Array r ix e) , Mutable r e - , Construct r ix e + , Load r ix e , Show e , Arbitrary e , Arbitrary ix @@ -69,7 +69,7 @@ prop_GenerateArray = prop_Shrink :: forall r ix e. - (Show (Array r ix e), Mutable r e, Construct r ix e, Arbitrary ix, Arbitrary e, Eq e) + (Show (Array r ix e), Mutable r e, Load r ix e, Arbitrary ix, Arbitrary e, Eq e) => Property prop_Shrink = property $ \ (ArrIx arr ix) -> runST $ do @@ -84,7 +84,6 @@ prop_GrowShrink :: , Show (Array r ix e) , Load r ix e , Mutable r e - , Construct r ix e , Arbitrary ix , Arbitrary e , Show e @@ -190,7 +189,6 @@ mutableSpec :: , Show e , Eq e , Mutable r e - , Construct r ix e , CoArbitrary ix , Arbitrary e , CoArbitrary e diff --git a/massiv-test/src/Test/Massiv/Array/Numeric.hs b/massiv-test/src/Test/Massiv/Array/Numeric.hs index 0b793744..bd686e41 100644 --- a/massiv-test/src/Test/Massiv/Array/Numeric.hs +++ b/massiv-test/src/Test/Massiv/Array/Numeric.hs @@ -55,7 +55,7 @@ prop_MatrixVectorMultiply :: forall r e. ( Numeric r e , Mutable r e - , Construct r Ix1 e + , Load r Ix1 e , Eq e , Show e ) @@ -73,7 +73,7 @@ prop_MatrixVectorMultiply f arr = prop_VectorMatrixMultiply :: forall r e. ( Numeric r e - , Construct r Ix1 e + , Load r Ix1 e , Source r e , Mutable r e , Show (Vector r e) @@ -93,7 +93,7 @@ prop_VectorMatrixMultiply f arr = (== SizeMismatchException (Sz2 1 (m + 1)) (size arr)) prop_DotProduct :: - forall r e. (Numeric r e, Mutable r e, Eq e, Show e, Construct r Ix1 e) + forall r e. (Numeric r e, Mutable r e, Eq e, Show e, Load r Ix1 e) => Fun e e -> Vector r e -> Property @@ -228,8 +228,8 @@ mutableNumericSpec :: forall r e. ( Numeric r e , Mutable r e - , Construct r Ix1 e - , Construct r Ix2 e + , Load r Ix1 e + , Load r Ix2 e , Eq e , Show e , Function e diff --git a/massiv-test/src/Test/Massiv/Core/Common.hs b/massiv-test/src/Test/Massiv/Core/Common.hs index a56d7688..8dae5410 100644 --- a/massiv-test/src/Test/Massiv/Core/Common.hs +++ b/massiv-test/src/Test/Massiv/Core/Common.hs @@ -62,29 +62,29 @@ instance Arbitrary Comp where ] -arbitraryArray :: (Construct r ix e, Arbitrary e) => Gen (Sz ix) -> Gen (Array r ix e) +arbitraryArray :: (Load r ix e, Arbitrary e) => Gen (Sz ix) -> Gen (Array r ix e) arbitraryArray szGen = makeArrayLinear <$> arbitrary <*> szGen <*> arbitrary -- | Arbitrary array -instance (Arbitrary ix, Construct r ix e, Arbitrary e) => +instance (Arbitrary ix, Load r ix e, Arbitrary e) => Arbitrary (Array r ix e) where arbitrary = makeArrayLinear <$> arbitrary <*> arbitrary <*> arbitrary -instance (Arbitrary ix, Construct r ix e, Arbitrary e) => Arbitrary (ArrTiny r ix e) where +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, Construct r ix e, Arbitrary e) => +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, Construct r ix e, Arbitrary e) => +instance (Arbitrary ix, Load r ix e, Arbitrary e) => Arbitrary (ArrNE r ix e) where arbitrary = ArrNE <$> arbitraryArray (unSzNE <$> arbitrary) -instance (Arbitrary ix, Construct r ix e, Arbitrary e) => +instance (Arbitrary ix, Load r ix e, Arbitrary e) => Arbitrary (ArrIx r ix e) where arbitrary = do SzIx sz ix <- arbitrary diff --git a/massiv-test/src/Test/Massiv/Core/Mutable.hs b/massiv-test/src/Test/Massiv/Core/Mutable.hs index d7a24b79..fc61cda5 100644 --- a/massiv-test/src/Test/Massiv/Core/Mutable.hs +++ b/massiv-test/src/Test/Massiv/Core/Mutable.hs @@ -247,7 +247,7 @@ unsafeMutableSpec :: , Mutable r e , Show e , Eq e - , Construct r ix e + , Load r ix e , Arbitrary e , Arbitrary ix , Typeable e diff --git a/massiv-test/tests/Test/Massiv/Array/Manifest/VectorSpec.hs b/massiv-test/tests/Test/Massiv/Array/Manifest/VectorSpec.hs index 38d59d12..802a98c8 100644 --- a/massiv-test/tests/Test/Massiv/Array/Manifest/VectorSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/Manifest/VectorSpec.hs @@ -38,7 +38,7 @@ prop_toFromVector :: , Show (Array r ix Int) , Typeable v , Load (ARepr v) ix Int - , Construct r ix Int + , Load r ix Int ) => Proxy v -> Proxy ix diff --git a/massiv-test/tests/Test/Massiv/Array/ManifestSpec.hs b/massiv-test/tests/Test/Massiv/Array/ManifestSpec.hs index 7caef620..97aface1 100644 --- a/massiv-test/tests/Test/Massiv/Array/ManifestSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/ManifestSpec.hs @@ -14,15 +14,16 @@ import Data.Word (Word8) -- ByteString -prop_toFromByteString :: Load r Ix1 Word8 => Manifest r Word8 => Vector r Word8 -> Property -prop_toFromByteString arr = toManifest arr === fromByteString (getComp arr) (toByteString arr) +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) +prop_fromToByteString comp ls = bs === toByteString (fromByteString comp bs :: Vector P Word8) where bs = S.pack ls prop_toBuilder :: Array P Ix1 Word8 -> Property diff --git a/massiv-test/tests/Test/Massiv/Array/MutableSpec.hs b/massiv-test/tests/Test/Massiv/Array/MutableSpec.hs index 268e3e85..f6bf24eb 100644 --- a/massiv-test/tests/Test/Massiv/Array/MutableSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/MutableSpec.hs @@ -31,7 +31,7 @@ type MutableArraySpec r ix e , Arbitrary (Array r ix e) , Mutable r e , Stream r ix e - , Construct r ix e) + ) type MutableSpec r e = ( Typeable e diff --git a/massiv-test/tests/Test/Massiv/Array/Ops/SliceSpec.hs b/massiv-test/tests/Test/Massiv/Array/Ops/SliceSpec.hs index e06b3796..d4c2126e 100644 --- a/massiv-test/tests/Test/Massiv/Array/Ops/SliceSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/Ops/SliceSpec.hs @@ -140,7 +140,7 @@ prop_SliceIndexDim4 (ArrIx arr ix@(i1 :> i2 :> i3 :. i4)) = specSliceN :: ( HasCallStack , Source r e - , Construct r ix e + , Load r ix e , Arbitrary ix , Arbitrary e , Show (Array r ix e) diff --git a/massiv-test/tests/Test/Massiv/Array/Ops/SortSpec.hs b/massiv-test/tests/Test/Massiv/Array/Ops/SortSpec.hs index 6634017d..2b898ef8 100644 --- a/massiv-test/tests/Test/Massiv/Array/Ops/SortSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/Ops/SortSpec.hs @@ -14,7 +14,7 @@ prop_IsSorted sortWith from to xs = to (sortWith (from xs)) === sort xs tallyMap :: Array P Ix1 Word -> Map Word Int -tallyMap arr = F.foldr' addCount M.empty $ toManifest arr +tallyMap = foldrS addCount M.empty where addCount :: Word -> Map Word Int -> Map Word Int addCount !el !counter = M.insertWith (+) el 1 counter diff --git a/massiv-test/tests/Test/Massiv/Array/Ops/TransformSpec.hs b/massiv-test/tests/Test/Massiv/Array/Ops/TransformSpec.hs index 758aaea0..2e68123d 100644 --- a/massiv-test/tests/Test/Massiv/Array/Ops/TransformSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/Ops/TransformSpec.hs @@ -61,7 +61,7 @@ prop_SplitExtract (DimIx dim) (ArrIx arr ix) (Positive n) = (splitLeft, splitRight) = splitAt' dim (i + n') arr prop_ConcatAppend :: - forall r ix. (Eq (Array r ix Int), Show (Array r ix Int), Construct r ix Int, Mutable r Int) + forall r ix. (Eq (Array r ix Int), Show (Array r ix Int), Load r ix Int, Mutable r Int) => DimIx ix -> Comp -> Sz ix @@ -75,7 +75,7 @@ prop_ConcatAppend (DimIx dim) comp sz (NonEmpty fns) = prop_ConcatMConcatOuterM :: forall r ix. - (Eq (Array r ix Int), Show (Array r ix Int), Construct r ix Int, Mutable r Int) + (Eq (Array r ix Int), Show (Array r ix Int), Load r ix Int, Mutable r Int) => Comp -> Sz ix -> NonEmptyList (Fun ix Int) @@ -212,8 +212,8 @@ type Transform r ix e , NFData (Array r ix e) , NFData (Array r Int e) , Resize r - , Construct r ix e - , Construct r ix Int + , Load r ix e + , Load r ix Int , Ragged L ix e , Source r e , StrideLoad r ix e diff --git a/massiv-test/tests/Test/Massiv/ArraySpec.hs b/massiv-test/tests/Test/Massiv/ArraySpec.hs index 2ce1c0d0..cca3b7d3 100644 --- a/massiv-test/tests/Test/Massiv/ArraySpec.hs +++ b/massiv-test/tests/Test/Massiv/ArraySpec.hs @@ -13,7 +13,7 @@ import Test.Massiv.Core prop_Construct_makeArray_Manifest :: - forall r ix. (Load D ix Int, Ragged L ix Int, Source r Int, Construct r ix Int) + forall r ix. (Ragged L ix Int, Source r Int, Load r ix Int) => Comp -> Sz ix -> Fun Int Int @@ -23,7 +23,7 @@ prop_Construct_makeArray_Manifest comp sz f = delay (setComp Seq (makeArray comp sz (apply f . toLinearIndex sz) :: Array r ix Int)) prop_Construct_makeArray_Delayed :: - forall r ix. (Load D ix Int, Ragged L ix Int, Construct r ix Int) + forall r ix. (Ragged L ix Int, Load r ix Int) => Comp -> Sz ix -> Fun Int Int @@ -34,7 +34,7 @@ prop_Construct_makeArray_Delayed comp sz f = prop_Functor :: forall r ix. - (Load D ix Int, Ragged L ix Int, Construct r ix Int, Functor (Array r ix)) + (Ragged L ix Int, Load r ix Int, Functor (Array r ix)) => Comp -> Sz ix -> Fun Int Int @@ -46,9 +46,8 @@ prop_Functor comp sz f g = prop_Extract :: forall r ix. - ( Load D ix Int - , Ragged L ix Int - , Construct r ix Int + ( Ragged L ix Int + , Load r ix Int , Source r Int ) => Comp @@ -66,10 +65,9 @@ prop_Extract comp sz f start newSize = prop_IxUnbox :: forall ix. - ( Load D ix ix - , Ragged L ix ix - , Construct U ix ix + ( Ragged L ix ix , Source U ix + , Unbox ix ) => Comp -> Sz ix @@ -80,7 +78,7 @@ prop_IxUnbox comp sz f = delay (makeArrayLinear comp sz (apply f) :: Array U ix ix) prop_computeWithStride :: - forall r ix. (Load D ix Int, Ragged L ix Int, StrideLoad r ix Int, Construct r ix Int) + forall r ix. (Ragged L ix Int, StrideLoad r ix Int) => Comp -> Sz ix -> Fun Int Int @@ -96,7 +94,7 @@ prop_computeWithStride comp sz f stride = specCommon :: forall ix. - (Arbitrary ix, Load D ix Int, StrideLoad DW ix Int, Ragged L ix Int, Ragged L ix ix, Unbox ix) + (Arbitrary ix, StrideLoad DW ix Int, Ragged L ix Int, Ragged L ix ix, Unbox ix) => Spec specCommon = describe "Construct" $ do diff --git a/massiv-test/tests/Test/Massiv/Core/ListSpec.hs b/massiv-test/tests/Test/Massiv/Core/ListSpec.hs index a68c893f..a1937f44 100644 --- a/massiv-test/tests/Test/Massiv/Core/ListSpec.hs +++ b/massiv-test/tests/Test/Massiv/Core/ListSpec.hs @@ -1,11 +1,9 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} module Test.Massiv.Core.ListSpec (spec) where import Data.Massiv.Array @@ -17,5 +15,3 @@ spec :: Spec spec = do describe "L" $ it "toStream" $ property (prop_toStreamIsList @L @Int) - describe "LN" $ - it "toStream" $ property (prop_toStreamIsList @LN @Int) diff --git a/massiv/CHANGELOG.md b/massiv/CHANGELOG.md index d7f17735..df81236c 100644 --- a/massiv/CHANGELOG.md +++ b/massiv/CHANGELOG.md @@ -1,5 +1,7 @@ # 1.0.0 +* Consolidate `Construct` class into `Load` +* Get rid of `M` representation * Introduce `Shape`, the parent of `Size` * Move `size` from `Load` into new class `Size` * Removed `maxSize` and replaced it with `maxLinearSize` diff --git a/massiv/src/Data/Massiv/Array/Delayed/Interleaved.hs b/massiv/src/Data/Massiv/Array/Delayed/Interleaved.hs index c936d187..42532eb8 100644 --- a/massiv/src/Data/Massiv/Array/Delayed/Interleaved.hs +++ b/massiv/src/Data/Massiv/Array/Delayed/Interleaved.hs @@ -42,11 +42,6 @@ instance Strategy DI where getComp = dComp . diArray {-# INLINE getComp #-} - -instance Index ix => Construct DI ix e where - makeArray c sz = DIArray . makeArray c sz - {-# INLINE makeArray #-} - instance Index ix => Shape DI ix where maxLinearSize = Just . SafeSz . elemsCount {-# INLINE maxLinearSize #-} @@ -62,6 +57,8 @@ instance Resize DI where instance Index ix => Load DI ix e where + makeArray c sz = DIArray . makeArray c sz + {-# INLINE makeArray #-} loadArrayM scheduler (DIArray (DArray _ sz f)) uWrite = loopM_ 0 (< numWorkers scheduler) (+ 1) $ \ !start -> scheduleWork scheduler $ diff --git a/massiv/src/Data/Massiv/Array/Delayed/Pull.hs b/massiv/src/Data/Massiv/Array/Delayed/Pull.hs index f8715e69..9210e6cf 100644 --- a/massiv/src/Data/Massiv/Array/Delayed/Pull.hs +++ b/massiv/src/Data/Massiv/Array/Delayed/Pull.hs @@ -72,11 +72,6 @@ instance Strategy D where getComp = dComp {-# INLINE getComp #-} -instance Index ix => Construct D ix e where - makeArray = DArray - {-# INLINE makeArray #-} - - instance Source D e where unsafeIndex = INDEX_CHECK("(Source D ix e).unsafeIndex", size, dIndex) {-# INLINE unsafeIndex #-} @@ -159,6 +154,8 @@ instance Index ix => Foldable (Array D ix) where instance Index ix => Load D ix e where + makeArray = DArray + {-# INLINE makeArray #-} loadArrayM !scheduler !arr = splitLinearlyWith_ scheduler (elemsCount arr) (unsafeLinearIndex arr) {-# INLINE loadArrayM #-} diff --git a/massiv/src/Data/Massiv/Array/Delayed/Push.hs b/massiv/src/Data/Massiv/Array/Delayed/Push.hs index 1cc65e08..613fa6e3 100644 --- a/massiv/src/Data/Massiv/Array/Delayed/Push.hs +++ b/massiv/src/Data/Massiv/Array/Delayed/Push.hs @@ -60,18 +60,6 @@ instance Strategy DL where {-# INLINE setComp #-} -instance Index ix => Construct DL ix e where - makeArrayLinear comp sz f = DLArray comp sz load - where - load :: Monad m => - Scheduler m () -> Ix1 -> (Ix1 -> e -> m ()) -> (Ix1 -> Sz1 -> e -> m ()) -> m () - load scheduler startAt dlWrite _ = - splitLinearlyWithStartAtM_ scheduler startAt (totalElem sz) (pure . f) dlWrite - {-# INLINE load #-} - {-# INLINE makeArrayLinear #-} - replicate comp !sz !e = makeLoadArray comp sz e $ \_ _ -> pure () - {-# INLINE replicate #-} - instance Index ix => Shape DL ix where maxLinearSize = Just . SafeSz . elemsCount {-# INLINE maxLinearSize #-} @@ -325,6 +313,16 @@ fromStrideLoad stride arr = {-# INLINE fromStrideLoad #-} instance Index ix => Load DL ix e where + makeArrayLinear comp sz f = DLArray comp sz load + where + load :: Monad m => + Scheduler m () -> Ix1 -> (Ix1 -> e -> m ()) -> (Ix1 -> Sz1 -> e -> m ()) -> m () + load scheduler startAt dlWrite _ = + splitLinearlyWithStartAtM_ scheduler startAt (totalElem sz) (pure . f) dlWrite + {-# INLINE load #-} + {-# INLINE makeArrayLinear #-} + replicate comp !sz !e = makeLoadArray comp sz e $ \_ _ -> pure () + {-# INLINE replicate #-} loadArrayWithSetM scheduler DLArray {dlLoad} = dlLoad scheduler 0 {-# INLINE loadArrayWithSetM #-} diff --git a/massiv/src/Data/Massiv/Array/Delayed/Stream.hs b/massiv/src/Data/Massiv/Array/Delayed/Stream.hs index 0edf55a6..b7182cad 100644 --- a/massiv/src/Data/Massiv/Array/Delayed/Stream.hs +++ b/massiv/src/Data/Massiv/Array/Delayed/Stream.hs @@ -184,18 +184,13 @@ toStreamIxM = S.transStepsId . toStreamIx {-# INLINE toStreamIxM #-} -instance Construct DS Ix1 e where +-- | /O(n)/ - `size` implementation. +instance Load DS Ix1 e where makeArrayLinear _ k = fromSteps . S.generate k {-# INLINE makeArrayLinear #-} - - --- instance Extract DS Ix1 e where --- unsafeExtract sIx newSz = fromSteps . S.slice sIx (unSz newSz) . dsArray --- {-# INLINE unsafeExtract #-} - --- | /O(n)/ - `size` implementation. -instance Load DS Ix1 e where + replicate _ k = fromSteps . S.replicate k + {-# INLINE replicate #-} loadArrayM _scheduler arr uWrite = case stepsSize (dsArray arr) of diff --git a/massiv/src/Data/Massiv/Array/Delayed/Windowed.hs b/massiv/src/Data/Massiv/Array/Delayed/Windowed.hs index 2a2d5c27..089fd200 100644 --- a/massiv/src/Data/Massiv/Array/Delayed/Windowed.hs +++ b/massiv/src/Data/Massiv/Array/Delayed/Windowed.hs @@ -69,13 +69,6 @@ instance Strategy DW where {-# INLINE getComp #-} -instance Load DW ix e => Construct DW ix e where - - makeArray c sz f = DWArray (makeArray c sz f) Nothing - {-# INLINE makeArray #-} - - - instance Functor (Array DW ix) where fmap f arr@DWArray{dwArray, dwWindow} = arr @@ -222,6 +215,8 @@ instance Size DW where {-# INLINE size #-} instance Load DW Ix1 e where + makeArray c sz f = DWArray (makeArray c sz f) Nothing + {-# INLINE makeArray #-} loadArrayM scheduler arr uWrite = do (loadWindow, wStart, wEnd) <- loadWithIx1 (scheduleWork scheduler) arr uWrite let (chunkWidth, slackWidth) = (wEnd - wStart) `quotRem` numWorkers scheduler @@ -342,6 +337,8 @@ loadWindowIx2 nWorkers loadWindow (it :. ib) = do instance Load DW Ix2 e where + makeArray c sz f = DWArray (makeArray c sz f) Nothing + {-# INLINE makeArray #-} loadArrayM scheduler arr uWrite = loadWithIx2 (scheduleWork scheduler) arr uWrite >>= uncurry (loadWindowIx2 (numWorkers scheduler)) @@ -355,6 +352,8 @@ instance StrideLoad DW Ix2 e where instance (Index (IxN n), Load DW (Ix (n - 1)) e) => Load DW (IxN n) e where + makeArray c sz f = DWArray (makeArray c sz f) Nothing + {-# INLINE makeArray #-} loadArrayM = loadWithIxN {-# INLINE loadArrayM #-} diff --git a/massiv/src/Data/Massiv/Array/Manifest.hs b/massiv/src/Data/Massiv/Array/Manifest.hs index 0add0d0a..4be3f906 100644 --- a/massiv/src/Data/Massiv/Array/Manifest.hs +++ b/massiv/src/Data/Massiv/Array/Manifest.hs @@ -17,8 +17,6 @@ module Data.Massiv.Array.Manifest ( -- * Manifest Manifest - , toManifest - , M -- * Boxed , B(..) , BL(..) @@ -123,15 +121,16 @@ import Data.Massiv.Array.Ops.Fold import Data.Massiv.Core.Common import Data.Word (Word8) --- | /O(1)/ - Convert a strict ByteString into a manifest array. Will return `Nothing` if length +-- | /O(n)/ - Convert a strict ByteString into a manifest array. Will return `Nothing` if length -- doesn't match the total number of elements of new array. -- -- @since 0.2.1 fromByteString :: - Comp -- ^ Computation strategy + Load r Ix1 Word8 + => Comp -- ^ Computation strategy -> ByteString -- ^ Strict ByteString to use as a source. - -> Array M Ix1 Word8 -fromByteString comp bs = MArray comp (SafeSz (S.length bs)) (SU.unsafeIndex bs) + -> Vector r Word8 +fromByteString comp bs = makeArrayLinear comp (SafeSz (S.length bs)) (SU.unsafeIndex bs) {-# INLINE fromByteString #-} -- | /O(n)/ - Convert any source array into a strict `ByteString`. In case when the source array is diff --git a/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs b/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs index 19eaa81d..21f3775e 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs @@ -136,14 +136,6 @@ instance Strategy BL where {-# INLINE getComp #-} -instance Index ix => Construct BL ix e where - - makeArrayLinear !comp !sz f = unsafePerformIO $ generateArrayLinear comp sz (pure . f) - {-# INLINE makeArrayLinear #-} - - replicate comp sz e = runST (newMArray sz e >>= unsafeFreeze comp) - {-# INLINE replicate #-} - instance Source BL e where unsafeLinearIndex (BLArray _ _sz o a) i = INDEX_CHECK("(Source BL ix e).unsafeLinearIndex", @@ -213,6 +205,12 @@ instance Index ix => Shape BL ix where {-# INLINE maxLinearSize #-} instance Index ix => Load BL ix e where + makeArrayLinear !comp !sz f = unsafePerformIO $ generateArrayLinear comp sz (pure . f) + {-# INLINE makeArrayLinear #-} + + replicate comp sz e = runST (newMArray sz e >>= unsafeFreeze comp) + {-# INLINE replicate #-} + loadArrayM !scheduler !arr = splitLinearlyWith_ scheduler (elemsCount arr) (unsafeLinearIndex arr) {-# INLINE loadArrayM #-} @@ -312,13 +310,6 @@ instance (Index ix, Ord e) => Ord (Array B ix e) where {-# INLINE compare #-} -instance Index ix => Construct B ix e where - makeArrayLinear !comp !sz f = unsafePerformIO $ generateArrayLinear comp sz (pure . f) - {-# INLINE makeArrayLinear #-} - - replicate comp sz e = runST (newMArray sz e >>= unsafeFreeze comp) - {-# INLINE replicate #-} - instance Source B e where unsafeLinearIndex arr = unsafeLinearIndex (toLazyArray arr) {-# INLINE unsafeLinearIndex #-} @@ -385,6 +376,12 @@ instance Mutable B e where {-# INLINE unsafeLinearWrite #-} instance Index ix => Load B ix e where + makeArrayLinear !comp !sz f = unsafePerformIO $ generateArrayLinear comp sz (pure . f) + {-# INLINE makeArrayLinear #-} + + replicate comp sz e = runST (newMArray sz e >>= unsafeFreeze comp) + {-# INLINE replicate #-} + loadArrayM scheduler = coerce (loadArrayM scheduler) {-# INLINE loadArrayM #-} @@ -496,12 +493,6 @@ instance Strategy N where getComp = blComp . coerce {-# INLINE getComp #-} -instance (Index ix, NFData e) => Construct BN ix e where - makeArrayLinear !comp !sz f = unsafePerformIO $ generateArrayLinear comp sz (pure . f) - {-# INLINE makeArrayLinear #-} - replicate comp sz e = runST (newMArray sz e >>= unsafeFreeze comp) - {-# INLINE replicate #-} - instance NFData e => Source BN e where unsafeLinearIndex (BNArray arr) = unsafeLinearIndex arr {-# INLINE unsafeLinearIndex #-} @@ -559,6 +550,10 @@ instance NFData e => Mutable BN e where {-# INLINE unsafeLinearWrite #-} instance (Index ix, NFData e) => Load BN ix e where + makeArrayLinear !comp !sz f = unsafePerformIO $ generateArrayLinear comp sz (pure . f) + {-# INLINE makeArrayLinear #-} + replicate comp sz e = runST (newMArray sz e >>= unsafeFreeze comp) + {-# INLINE replicate #-} loadArrayM !scheduler !arr = splitLinearlyWith_ scheduler (elemsCount arr) (unsafeLinearIndex arr) {-# INLINE loadArrayM #-} diff --git a/massiv/src/Data/Massiv/Array/Manifest/Internal.hs b/massiv/src/Data/Massiv/Array/Manifest/Internal.hs index c9fee564..8dc877cc 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Internal.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Internal.hs @@ -17,10 +17,8 @@ -- Portability : non-portable -- module Data.Massiv.Array.Manifest.Internal - ( M - , Manifest(..) + ( Manifest(..) , Array(..) - , toManifest , compute , computeS , computeP @@ -47,18 +45,13 @@ module Data.Massiv.Array.Manifest.Internal import Control.Exception (try) import Control.Monad.ST import Control.Scheduler -import qualified Data.Foldable as F (Foldable(..)) import Data.Massiv.Array.Delayed.Pull import Data.Massiv.Array.Mutable -import Data.Massiv.Array.Ops.Fold.Internal as A import Data.Massiv.Array.Mutable.Internal (unsafeCreateArray_) -import Data.Massiv.Vector.Stream as S (steps, isteps) import Data.Massiv.Core.Common import Data.Massiv.Core.List -import Data.Massiv.Core.Operations import Data.Maybe (fromMaybe) import Data.Typeable -import GHC.Base hiding (ord) import System.IO.Unsafe (unsafePerformIO) #if MIN_VERSION_primitive(0,6,2) @@ -77,126 +70,6 @@ sizeofMutableArray (A.MutableArray ma) = I# (sizeofMutableArray# ma) {-# INLINE sizeofMutableArray #-} #endif - --- | General Manifest representation -data M - -data instance Array M ix e = MArray { mComp :: !Comp - , mSize :: !(Sz ix) - , mLinearIndex :: Int -> e } - -instance (Ragged L ix e, Show e) => Show (Array M ix e) where - showsPrec = showsArrayPrec id - showList = showArrayList - - -instance (Eq e, Index ix) => Eq (Array M ix e) where - (==) = eqArrays (==) - {-# INLINE (==) #-} - -instance (Ord e, Index ix) => Ord (Array M ix e) where - compare = compareArrays compare - {-# INLINE compare #-} - - --- | /O(1)/ - Conversion of `Manifest` arrays to `M` representation. -toManifest :: (Index ix, Manifest r e) => Array r ix e -> Array M ix e -toManifest !arr = MArray (getComp arr) (size arr) (unsafeLinearIndexM arr) -{-# INLINE toManifest #-} - - --- | Row-major sequentia folding over a Manifest array. -instance Index ix => Foldable (Array M ix) where - fold = fold - {-# INLINE fold #-} - foldMap = foldMono - {-# INLINE foldMap #-} - foldl = lazyFoldlS - {-# INLINE foldl #-} - foldl' = foldlS - {-# INLINE foldl' #-} - foldr = foldrFB - {-# INLINE foldr #-} - foldr' = foldrS - {-# INLINE foldr' #-} - null (MArray _ sz _) = totalElem sz == 0 - {-# INLINE null #-} - length = totalElem . size - {-# INLINE length #-} - elem e = A.any (e ==) - {-# INLINE elem #-} - toList arr = build (\ c n -> foldrFB c n arr) - {-# INLINE toList #-} - - -instance Strategy M where - getComp = mComp - {-# INLINE getComp #-} - setComp comp arr = arr {mComp = comp} - {-# INLINE setComp #-} - - -instance Source M e where - unsafeLinearIndex = mLinearIndex - {-# INLINE unsafeLinearIndex #-} - - unsafeOuterSlice = unsafeOuterSliceN - {-# INLINE unsafeOuterSlice #-} - - unsafeLinearSlice off sz arr = MArray (getComp arr) sz (unsafeLinearIndex arr . (+ off)) - {-# INLINE unsafeLinearSlice #-} - - -instance Manifest M e where - - unsafeLinearIndexM = mLinearIndex - {-# INLINE unsafeLinearIndexM #-} - -instance Index ix => Shape M ix - -instance Size M where - size = mSize - {-# INLINE size #-} - -instance Resize M where - unsafeResize !sz !arr = arr { mSize = sz } - {-# INLINE unsafeResize #-} - - - - -unsafeOuterSliceN :: - forall r ix e. (Source r e, Index ix, Index (Lower ix)) - => Array r ix e - -> Sz (Lower ix) - -> Int - -> Array M (Lower ix) e -unsafeOuterSliceN !arr szL !i = MArray (getComp arr) szL (unsafeLinearIndex arr . (+ kStart)) - where - !kStart = toLinearIndex (size arr) (consDim i (zeroIndex :: Lower ix)) -{-# INLINE unsafeOuterSliceN #-} - -instance Index ix => Load M ix e where - loadArrayM scheduler (MArray _ sz f) = splitLinearlyWith_ scheduler (totalElem sz) f - {-# INLINE loadArrayM #-} - -instance Index ix => StrideLoad M ix e - -instance Index ix => Stream M ix e where - toStream = S.steps - {-# INLINE toStream #-} - toStreamIx = S.isteps - {-# INLINE toStreamIx #-} - - -instance Num e => FoldNumeric M e where - unsafeDotProduct = defaultUnsafeDotProduct - {-# INLINE unsafeDotProduct #-} - powerSumArray = defaultPowerSumArray - {-# INLINE powerSumArray #-} - foldArray = defaultFoldArray - {-# INLINE foldArray #-} - -- | Ensure that Array is computed, i.e. represented with concrete elements in memory, hence is the -- `Mutable` type class restriction. Use `setComp` if you'd like to change computation strategy -- before calling @compute@ @@ -221,7 +94,7 @@ computeS !arr = runST $ computePrimM arr -- -- @since 0.5.4 computeP :: - forall r ix e r'. (Mutable r e, Construct r' ix e) + forall r ix e r'. (Mutable r e, Load r' ix e) => Array r' ix e -> Array r ix e computeP arr = setComp (getComp arr) $ compute (setComp Par arr) diff --git a/massiv/src/Data/Massiv/Array/Manifest/List.hs b/massiv/src/Data/Massiv/Array/Manifest/List.hs index db6304a4..12d319ac 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/List.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/List.hs @@ -170,7 +170,7 @@ toList !arr = build (\ c n -> foldrFB c n arr) -- [[[0 :> 0 :. 0,0 :> 0 :. 1,0 :> 0 :. 2]],[[1 :> 0 :. 0,1 :> 0 :. 1,1 :> 0 :. 2]]] -- -- @since 0.1.0 -toLists :: (Nested LN ix e, Construct L ix e, Load r ix e, Source r e) +toLists :: (Nested LN ix e, Ragged L ix e, Load r ix e, Source r e) => Array r ix e -> [ListItem ix e] toLists = toNested . toNested . toListArray diff --git a/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs b/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs index 90437f88..19653d90 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs @@ -109,13 +109,6 @@ instance Strategy P where setComp c arr = arr { pComp = c } {-# INLINE setComp #-} -instance (Prim e, Index ix) => Construct P ix e where - makeArrayLinear !comp !sz f = unsafePerformIO $ generateArrayLinear comp sz (pure . f) - {-# INLINE makeArrayLinear #-} - - replicate comp !sz !e = runST (newMArray sz e >>= unsafeFreeze comp) - {-# INLINE replicate #-} - instance Index ix => Shape P ix where maxLinearSize = Just . SafeSz . elemsCount @@ -211,6 +204,12 @@ instance Prim e => Mutable P e where instance (Prim e, Index ix) => Load P ix e where + makeArrayLinear !comp !sz f = unsafePerformIO $ generateArrayLinear comp sz (pure . f) + {-# INLINE makeArrayLinear #-} + + replicate comp !sz !e = runST (newMArray sz e >>= unsafeFreeze comp) + {-# INLINE replicate #-} + loadArrayM !scheduler !arr = splitLinearlyWith_ scheduler (elemsCount arr) (unsafeLinearIndex arr) {-# INLINE loadArrayM #-} diff --git a/massiv/src/Data/Massiv/Array/Manifest/Storable.hs b/massiv/src/Data/Massiv/Array/Manifest/Storable.hs index 4e90089e..391c0152 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Storable.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Storable.hs @@ -97,13 +97,6 @@ instance Strategy S where setComp c arr = arr { sComp = c } {-# INLINE setComp #-} -instance (Storable e, Index ix) => Construct S ix e where - makeArrayLinear !comp !sz f = unsafePerformIO $ generateArrayLinear comp sz (pure . f) - {-# INLINE makeArrayLinear #-} - - replicate comp !sz !e = runST (newMArray sz e >>= unsafeFreeze comp) - {-# INLINE replicate #-} - instance VS.Storable e => Source S e where unsafeLinearIndex (SArray _ _ v) = INDEX_CHECK("(Source S ix e).unsafeLinearIndex", Sz . VS.length, VS.unsafeIndex) v @@ -204,6 +197,12 @@ instance Storable e => Mutable S e where instance (Index ix, Storable e) => Load S ix e where + makeArrayLinear !comp !sz f = unsafePerformIO $ generateArrayLinear comp sz (pure . f) + {-# INLINE makeArrayLinear #-} + + replicate comp !sz !e = runST (newMArray sz e >>= unsafeFreeze comp) + {-# INLINE replicate #-} + loadArrayM !scheduler !arr = splitLinearlyWith_ scheduler (elemsCount arr) (unsafeLinearIndex arr) {-# INLINE loadArrayM #-} diff --git a/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs b/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs index 47770b90..f1a0d9fa 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs @@ -68,13 +68,6 @@ instance Strategy U where setComp c arr = arr { uComp = c } {-# INLINE setComp #-} -instance (VU.Unbox e, Index ix) => Construct U ix e where - makeArrayLinear !comp !sz f = unsafePerformIO $ generateArrayLinear comp sz (pure . f) - {-# INLINE makeArrayLinear #-} - - replicate comp !sz !e = runST (newMArray sz e >>= unsafeFreeze comp) - {-# INLINE replicate #-} - instance (Unbox e, Eq e, Index ix) => Eq (Array U ix e) where (==) = eqArrays (==) @@ -111,6 +104,12 @@ instance Resize U where {-# INLINE unsafeResize #-} instance (Unbox e, Index ix) => Load U ix e where + makeArrayLinear !comp !sz f = unsafePerformIO $ generateArrayLinear comp sz (pure . f) + {-# INLINE makeArrayLinear #-} + + replicate comp !sz !e = runST (newMArray sz e >>= unsafeFreeze comp) + {-# INLINE replicate #-} + loadArrayM !scheduler !arr = splitLinearlyWith_ scheduler (elemsCount arr) (unsafeLinearIndex arr) {-# INLINE loadArrayM #-} diff --git a/massiv/src/Data/Massiv/Array/Manifest/Vector.hs b/massiv/src/Data/Massiv/Array/Manifest/Vector.hs index 375c59ee..f93b114f 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Vector.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Vector.hs @@ -90,7 +90,7 @@ castFromVector comp sz vector = do -- -- @since 0.3.0 fromVectorM :: - (MonadThrow m, Typeable v, VG.Vector v a, Mutable r a, Load (ARepr v) ix a, Construct r ix a) + (MonadThrow m, Typeable v, VG.Vector v a, Mutable r a, Load (ARepr v) ix a, Load r ix a) => Comp -> Sz ix -- ^ Resulting size of the array -> v a -- ^ Source Vector @@ -108,7 +108,7 @@ fromVectorM comp sz v = -- -- @since 0.3.0 fromVector' :: - (Typeable v, VG.Vector v a, Load (ARepr v) ix a, Construct r ix a, Mutable r a) + (Typeable v, VG.Vector v a, Load (ARepr v) ix a, Load r ix a, Mutable r a) => Comp -> Sz ix -- ^ Resulting size of the array -> v a -- ^ Source Vector diff --git a/massiv/src/Data/Massiv/Array/Numeric/Integral.hs b/massiv/src/Data/Massiv/Array/Numeric/Integral.hs index 1f4be6b7..f1592a25 100644 --- a/massiv/src/Data/Massiv/Array/Numeric/Integral.hs +++ b/massiv/src/Data/Massiv/Array/Numeric/Integral.hs @@ -134,7 +134,7 @@ integralApprox :: -> Array r ix e -- ^ Array with values of @f(x,y,..)@ that will be used as source for integration. -> Array D ix e integralApprox stencil d sz n arr = - extract' zeroIndex sz $ toManifest $ loop 1 (<= coerce (dimensions sz)) (+ 1) arr integrateAlong + extract' zeroIndex sz $ loop 1 (<= coerce (dimensions sz)) (+ 1) arr integrateAlong where !dx = d / fromIntegral n integrateAlong dim = integrateWith (stencil dx) (Dim dim) n diff --git a/massiv/src/Data/Massiv/Array/Ops/Construct.hs b/massiv/src/Data/Massiv/Array/Ops/Construct.hs index 470edda3..cc6f1e14 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Construct.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Construct.hs @@ -95,21 +95,21 @@ import System.Random.Stateful -- ] -- -- @since 0.1.0 -makeArrayR :: Construct r ix e => r -> Comp -> Sz ix -> (ix -> e) -> Array r ix e +makeArrayR :: Load r ix e => r -> Comp -> Sz ix -> (ix -> e) -> Array r ix e makeArrayR _ = makeArray {-# INLINE makeArrayR #-} -- | Same as `makeArrayLinear`, but with ability to supply resulting representation -- -- @since 0.3.0 -makeArrayLinearR :: Construct r ix e => r -> Comp -> Sz ix -> (Int -> e) -> Array r ix e +makeArrayLinearR :: Load r ix e => r -> Comp -> Sz ix -> (Int -> e) -> Array r ix e makeArrayLinearR _ = makeArrayLinear {-# INLINE makeArrayLinearR #-} -- | Same as `makeArrayR`, but restricted to 1-dimensional arrays. -- -- @since 0.1.0 -makeVectorR :: Construct r Ix1 e => r -> Comp -> Sz1 -> (Ix1 -> e) -> Array r Ix1 e +makeVectorR :: Load r Ix1 e => r -> Comp -> Sz1 -> (Ix1 -> e) -> Vector r e makeVectorR _ = makeArray {-# INLINE makeVectorR #-} @@ -209,7 +209,12 @@ iiterateN sz f = iunfoldrS_ sz $ \a ix -> let !a' = f a ix in (a', a') -- [ 10, 11, 12, 13, 14, 15, 16, 17, 18, 19 ] -- -- @since 0.3.0 -unfoldrS_ :: forall ix e a . Construct DL ix e => Sz ix -> (a -> (e, a)) -> a -> Array DL ix e +unfoldrS_ :: + forall ix e a. Index ix + => Sz ix + -> (a -> (e, a)) + -> a + -> Array DL ix e unfoldrS_ sz f = iunfoldrS_ sz (\a _ -> f a) {-# INLINE unfoldrS_ #-} @@ -217,7 +222,7 @@ unfoldrS_ sz f = iunfoldrS_ sz (\a _ -> f a) -- -- @since 0.3.0 iunfoldrS_ :: - forall ix e a. Construct DL ix e + forall ix e a. Index ix => Sz ix -> (a -> ix -> (e, a)) -> a @@ -240,7 +245,7 @@ iunfoldrS_ sz f acc0 = DLArray {dlComp = Seq, dlSize = sz, dlLoad = load} -- `Data.Massiv.Array.Mutable.unfoldlPrimM` to achive such effect. -- -- @since 0.3.0 -unfoldlS_ :: Construct DL ix e => Sz ix -> (a -> (a, e)) -> a -> Array DL ix e +unfoldlS_ :: Index ix => Sz ix -> (a -> (a, e)) -> a -> Array DL ix e unfoldlS_ sz f = iunfoldlS_ sz (const f) {-# INLINE unfoldlS_ #-} @@ -248,7 +253,7 @@ unfoldlS_ sz f = iunfoldlS_ sz (const f) -- -- @since 0.3.0 iunfoldlS_ :: - forall ix e a. Construct DL ix e + forall ix e a. Index ix => Sz ix -> (ix -> a -> (a, e)) -> a @@ -291,14 +296,11 @@ iunfoldlS_ sz f acc0 = DLArray {dlComp = Seq, dlSize = sz, dlLoad = load} -- >>> gen = System.mkStdGen 217 -- >>> randomArray gen System.split System.random (ParN 2) (Sz2 2 3) :: Array DL Ix2 Double -- Array DL (ParN 2) (Sz (2 :. 3)) --- [ [ 0.15191527341922206, 0.2045537167404079, 0.9635356052820256 ] --- , [ 9.308278528094238e-2, 0.7200934018606843, 0.23173694193083583 ] +-- [ [ 0.2616843941380331, 0.600959468331641, 0.4382415961606372 ] +-- , [ 0.27812817813217605, 0.2993277194932741, 0.2774105268603957 ] -- ] -- -- @since 1.0.0 --- | Helper for generating random arrays --- --- @since 1.0.0 randomArray :: forall ix e g. Index ix => g -- ^ Initial random value generator @@ -355,7 +357,7 @@ uniformRangeArray :: -> Comp -- ^ Computation strategy. -> Sz ix -- ^ Resulting size of the array. -> Array DL ix e -uniformRangeArray gen range = randomArray gen split (uniformR range) +uniformRangeArray gen r = randomArray gen split (uniformR r) -- | Similar to `randomArray` but performs generation sequentially, which means it doesn't @@ -387,8 +389,8 @@ uniformRangeArray gen range = randomArray gen split (uniformR range) -- >>> gen = System.mkStdGen 217 -- >>> snd $ randomArrayS gen (Sz2 2 3) System.random :: Array P Ix2 Double -- Array P Seq (Sz (2 :. 3)) --- [ [ 0.7972230393466304, 0.4485860543300083, 0.257773196880671 ] --- , [ 0.19115043859955794, 0.33784788936970034, 3.479381605706322e-2 ] +-- [ [ 0.11217260506402493, 0.8870919238985904, 0.2616843941380331 ] +-- , [ 0.600959468331641, 0.4382415961606372, 0.8375162573397977 ] -- ] -- -- @since 0.3.4 diff --git a/massiv/src/Data/Massiv/Core.hs b/massiv/src/Data/Massiv/Core.hs index e044fd2c..de9f25f0 100644 --- a/massiv/src/Data/Massiv/Core.hs +++ b/massiv/src/Data/Massiv/Core.hs @@ -13,7 +13,6 @@ module Data.Massiv.Core , Matrix , MMatrix , Elt - , Construct , Load(loadArrayM, loadArrayWithSetM) , Stream(..) , Source diff --git a/massiv/src/Data/Massiv/Core/Common.hs b/massiv/src/Data/Massiv/Core/Common.hs index 564611b4..d92ff086 100644 --- a/massiv/src/Data/Massiv/Core/Common.hs +++ b/massiv/src/Data/Massiv/Core/Common.hs @@ -24,7 +24,6 @@ module Data.Massiv.Core.Common , Steps(..) , Stream(..) , Strategy(..) - , Construct(..) , Source(..) , Load(..) , StrideLoad(..) @@ -186,62 +185,6 @@ class Typeable r => Strategy r where -- @since 0.1.0 getComp :: Array r ix e -> Comp --- TODO: rename to ConstructP - --- | Array types that can be constructed. -class Load r ix e => Construct r ix e where - {-# MINIMAL (makeArray|makeArrayLinear) #-} - - -- | Construct an Array. Resulting type either has to be unambiguously inferred or restricted - -- manually, like in the example below. Use "Data.Massiv.Array.makeArrayR" if you'd like to - -- specify representation as an argument. - -- - -- >>> import Data.Massiv.Array - -- >>> makeArray Seq (Sz (3 :. 4)) (\ (i :. j) -> if i == j then i else 0) :: Array D Ix2 Int - -- Array D Seq (Sz (3 :. 4)) - -- [ [ 0, 0, 0, 0 ] - -- , [ 0, 1, 0, 0 ] - -- , [ 0, 0, 2, 0 ] - -- ] - -- - -- Instead of restricting the full type manually we can use `TypeApplications` as convenience: - -- - -- >>> :set -XTypeApplications - -- >>> makeArray @P @_ @Double Seq (Sz2 3 4) $ \(i :. j) -> logBase (fromIntegral i) (fromIntegral j) - -- Array P Seq (Sz (3 :. 4)) - -- [ [ NaN, -0.0, -0.0, -0.0 ] - -- , [ -Infinity, NaN, Infinity, Infinity ] - -- , [ -Infinity, 0.0, 1.0, 1.5849625007211563 ] - -- ] - -- - -- @since 0.1.0 - makeArray :: - Comp -- ^ Computation strategy. Useful constructors are `Seq` and `Par` - -> Sz ix -- ^ Size of the result array. - -> (ix -> e) -- ^ Function to generate elements at a particular index - -> Array r ix e - makeArray comp sz f = makeArrayLinear comp sz (f . fromLinearIndex sz) - {-# INLINE makeArray #-} - - -- | Same as `makeArray`, but produce elements using linear row-major index. - -- - -- >>> import Data.Massiv.Array - -- >>> makeArrayLinear Seq (Sz (2 :. 4)) id :: Array D Ix2 Int - -- Array D Seq (Sz (2 :. 4)) - -- [ [ 0, 1, 2, 3 ] - -- , [ 4, 5, 6, 7 ] - -- ] - -- - -- @since 0.3.0 - makeArrayLinear :: Comp -> Sz ix -> (Int -> e) -> Array r ix e - makeArrayLinear comp sz f = makeArray comp sz (f . toLinearIndex sz) - {-# INLINE makeArrayLinear #-} - - - replicate :: Comp -> Sz ix -> e -> Array r ix e - replicate comp sz !e = makeArray comp sz (const e) - {-# INLINE replicate #-} - -- | Size hint -- @@ -375,7 +318,58 @@ class (Strategy r, Resize r) => Source r e where -- | Any array that can be computed and loaded into memory class (Strategy r, Shape r ix) => Load r ix e where - {-# MINIMAL (loadArrayM | loadArrayWithSetM) #-} + {-# MINIMAL (makeArray | makeArrayLinear), (loadArrayM | loadArrayWithSetM)#-} + + -- | Construct an Array. Resulting type either has to be unambiguously inferred or restricted + -- manually, like in the example below. Use "Data.Massiv.Array.makeArrayR" if you'd like to + -- specify representation as an argument. + -- + -- >>> import Data.Massiv.Array + -- >>> makeArray Seq (Sz (3 :. 4)) (\ (i :. j) -> if i == j then i else 0) :: Array D Ix2 Int + -- Array D Seq (Sz (3 :. 4)) + -- [ [ 0, 0, 0, 0 ] + -- , [ 0, 1, 0, 0 ] + -- , [ 0, 0, 2, 0 ] + -- ] + -- + -- Instead of restricting the full type manually we can use `TypeApplications` as convenience: + -- + -- >>> :set -XTypeApplications + -- >>> makeArray @P @_ @Double Seq (Sz2 3 4) $ \(i :. j) -> logBase (fromIntegral i) (fromIntegral j) + -- Array P Seq (Sz (3 :. 4)) + -- [ [ NaN, -0.0, -0.0, -0.0 ] + -- , [ -Infinity, NaN, Infinity, Infinity ] + -- , [ -Infinity, 0.0, 1.0, 1.5849625007211563 ] + -- ] + -- + -- @since 0.1.0 + makeArray :: + Comp -- ^ Computation strategy. Useful constructors are `Seq` and `Par` + -> Sz ix -- ^ Size of the result array. + -> (ix -> e) -- ^ Function to generate elements at a particular index + -> Array r ix e + makeArray comp sz f = makeArrayLinear comp sz (f . fromLinearIndex sz) + {-# INLINE makeArray #-} + + -- | Same as `makeArray`, but produce elements using linear row-major index. + -- + -- >>> import Data.Massiv.Array + -- >>> makeArrayLinear Seq (Sz (2 :. 4)) id :: Array D Ix2 Int + -- Array D Seq (Sz (2 :. 4)) + -- [ [ 0, 1, 2, 3 ] + -- , [ 4, 5, 6, 7 ] + -- ] + -- + -- @since 0.3.0 + makeArrayLinear :: Comp -> Sz ix -> (Int -> e) -> Array r ix e + makeArrayLinear comp sz f = makeArray comp sz (f . toLinearIndex sz) + {-# INLINE makeArrayLinear #-} + + + replicate :: Comp -> Sz ix -> e -> Array r ix e + replicate comp sz !e = makeArray comp sz (const e) + {-# INLINE replicate #-} + -- | Load an array into memory. -- @@ -703,7 +697,7 @@ class Nested r ix e where toNested :: Array r ix e -> NestedStruct r ix e -class Construct r ix e => Ragged r ix e where +class Load r ix e => Ragged r ix e where emptyR :: Comp -> Array r ix e @@ -736,7 +730,7 @@ class Construct r ix e => Ragged r ix e where -- -- @since 0.3.0 empty :: - forall r ix e. Construct r ix e + forall r ix e. Load r ix e => Array r ix e empty = makeArray Seq zeroSz (const (throwImpossible Uninitialized)) {-# INLINE empty #-} @@ -765,7 +759,7 @@ empty = makeArray Seq zeroSz (const (throwImpossible Uninitialized)) -- -- @since 0.1.0 singleton :: - forall r ix e. Construct r ix e + forall r ix e. Load r ix e => e -- ^ The only element -> Array r ix e singleton = makeArray Seq oneSz . const diff --git a/massiv/src/Data/Massiv/Core/List.hs b/massiv/src/Data/Massiv/Core/List.hs index 280872de..91a03b6e 100644 --- a/massiv/src/Data/Massiv/Core/List.hs +++ b/massiv/src/Data/Massiv/Core/List.hs @@ -34,7 +34,7 @@ import Control.Monad (unless, when) import Control.Scheduler import Data.Coerce import Data.Monoid -import Data.Foldable (foldr') +import Data.Functor.Identity import qualified Data.List as L import qualified Data.Massiv.Vector.Stream as S import Data.Massiv.Core.Common @@ -58,11 +58,6 @@ instance Strategy LN where getComp _ = Seq setComp _ = id -instance Construct LN Ix1 e where - makeArray _ (Sz n) f = coerce (L.map f [0 .. n - 1]) - {-# INLINE makeArray #-} - makeArrayLinear _ (Sz n) f = coerce (L.map f [0 .. n - 1]) - {-# INLINE makeArrayLinear #-} instance {-# OVERLAPPING #-} Nested LN Ix1 e where fromNested = coerce @@ -223,21 +218,13 @@ instance Ragged L Ix1 e where instance (Shape L ix, Ragged L ix e) => Load L ix e where + makeArray comp sz f = runIdentity $ generateRaggedM comp sz (pure . f) + {-# INLINE makeArray #-} loadArrayM scheduler arr uWrite = loadRagged (scheduleWork scheduler) uWrite 0 (totalElem sz) sz arr where !sz = outerSize arr {-# INLINE loadArrayM #-} - -instance (Shape LN ix, Ragged L ix e) => Load LN ix e where - loadArrayM scheduler arr uWrite = - loadRagged (scheduleWork scheduler) uWrite 0 (totalElem sz) sz arrL - where - !arrL = LArray Seq arr - !sz = outerSize arrL - {-# INLINE loadArrayM #-} - - instance Ragged L Ix2 e where emptyR comp = LArray comp (List []) {-# INLINE emptyR #-} @@ -349,43 +336,28 @@ instance Strategy L where getComp = lComp {-# INLINE getComp #-} -instance Construct L Ix1 e where - makeArray comp sz f = LArray comp $ List $ unsafePerformIO $ - withScheduler comp $ \scheduler -> - loopM_ 0 (< coerce sz) (+ 1) (scheduleWork scheduler . return . f) - {-# INLINE makeArray #-} - -instance Construct L Ix2 e where - makeArray = unsafeGenerateN - {-# INLINE makeArray #-} - -instance (Ragged L (Ix (n - 1)) e, Shape LN (Ix (n - 1)), Index (IxN n)) => - Construct L (IxN n) e where - makeArray = unsafeGenerateN - {-# INLINE makeArray #-} - --- TODO: benchmark against using unsafeGenerateM directly -unsafeGenerateN :: - ( Ragged r ix e - , Ragged r (Lower ix) e - , Elt r ix e ~ Array r (Lower ix) e ) - => Comp - -> Sz ix - -> (ix -> e) - -> Array r ix e -unsafeGenerateN comp sz f = unsafePerformIO $ do - let !(m, szL) = unconsSz sz - xs <- withScheduler comp $ \scheduler -> - loopM_ 0 (< coerce m) (+ 1) $ \i -> scheduleWork scheduler $ - generateRaggedM comp szL $ \ix -> return $ f (consDim i ix) - return $! foldr' consR (emptyR comp) xs -{-# INLINE unsafeGenerateN #-} +-- -- TODO: benchmark against using unsafeGenerateM directly +-- unsafeGenerateN :: +-- ( Ragged r ix e +-- , Ragged r (Lower ix) e +-- , Elt r ix e ~ Array r (Lower ix) e ) +-- => Comp +-- -> Sz ix +-- -> (ix -> e) +-- -> Array r ix e +-- unsafeGenerateN comp sz f = unsafePerformIO $ do +-- let !(m, szL) = unconsSz sz +-- xs <- withScheduler comp $ \scheduler -> +-- loopM_ 0 (< coerce m) (+ 1) $ \i -> scheduleWork scheduler $ +-- generateRaggedM comp szL $ \ix -> return $ f (consDim i ix) +-- return $! foldr' consR (emptyR comp) xs +-- {-# INLINE unsafeGenerateN #-} -- | Construct an array backed by linked lists from any source array -- -- @since 0.4.0 -toListArray :: (Construct L ix e, Load r ix e, Source r e) +toListArray :: (Ragged L ix e, Load r ix e, Source r e) => Array r ix e -> Array L ix e toListArray !arr = makeArray (getComp arr) (size arr) (unsafeIndex arr) @@ -455,16 +427,8 @@ showArrayList arrs = ('[':) . go arrs . (']':) go (x:xs) = (' ':) . shows x . ("\n," ++) . go xs -instance Stream LN Ix1 e where - toStream = S.fromList . coerce - {-# INLINE toStream #-} - - toStreamIx = S.indexed . S.fromList . coerce - {-# INLINE toStreamIx #-} - instance Stream L Ix1 e where - toStream = toStream . lData + toStream = S.fromList . unList . lData {-# INLINE toStream #-} - - toStreamIx = toStreamIx . lData + toStreamIx = S.indexed . S.fromList . unList . lData {-# INLINE toStreamIx #-} diff --git a/massiv/src/Data/Massiv/Core/Operations.hs b/massiv/src/Data/Massiv/Core/Operations.hs index 6013a226..8c2896ec 100644 --- a/massiv/src/Data/Massiv/Core/Operations.hs +++ b/massiv/src/Data/Massiv/Core/Operations.hs @@ -137,13 +137,13 @@ class FoldNumeric r e => Numeric r e where defaultUnsafeLiftArray :: - (Construct r ix e, Source r e) => (e -> e) -> Array r ix e -> Array r ix e + (Load r ix e, Source r e) => (e -> e) -> Array r ix e -> Array r ix e defaultUnsafeLiftArray f arr = makeArrayLinear (getComp arr) (size arr) (f . unsafeLinearIndex arr) {-# INLINE defaultUnsafeLiftArray #-} defaultUnsafeLiftArray2 :: - (Construct r ix e, Source r e) + (Load r ix e, Source r e) => (e -> e -> e) -> Array r ix e -> Array r ix e From e8571173523cc2295493e92e18b1477f731d1c97 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Thu, 22 Apr 2021 03:15:33 +0300 Subject: [PATCH 15/65] Fix examples and benchmarks --- massiv-bench/bench/Concat.hs | 4 ++-- massiv-bench/bench/Mutable.hs | 2 +- massiv-bench/src/Data/Massiv/Bench.hs | 4 ++-- massiv-bench/src/Data/Massiv/Bench/Matrix.hs | 2 +- massiv-examples/GameOfLife/app/GameOfLife.hs | 2 +- massiv-examples/examples/src/Examples/SortRows.hs | 8 ++++---- massiv-examples/stack.yaml | 6 +++++- massiv-examples/vision/app/MakeFilter.hs | 4 ++-- massiv-examples/vision/vision.cabal | 4 ++-- stack.yaml | 2 +- 10 files changed, 21 insertions(+), 17 deletions(-) diff --git a/massiv-bench/bench/Concat.hs b/massiv-bench/bench/Concat.hs index 117ec66a..bb121288 100644 --- a/massiv-bench/bench/Concat.hs +++ b/massiv-bench/bench/Concat.hs @@ -39,7 +39,7 @@ main = do ] concatMutableM :: - forall r' r ix e . (Size r', Load r' ix e, Mutable r e) + forall r' r ix e . (Size r', Load r' ix e, Load r ix e, Mutable r e) => [Array r' ix e] -> IO (Array r ix e) concatMutableM arrsF = @@ -68,7 +68,7 @@ concatMutableM arrsF = {-# INLINE concatMutableM #-} concatNewM :: - forall ix e r. (Index ix, Mutable r e) + forall ix e r. (Index ix, Mutable r e, Load r ix e) => [Array r ix e] -> IO (Array r ix e) concatNewM arrsF = diff --git a/massiv-bench/bench/Mutable.hs b/massiv-bench/bench/Mutable.hs index 35686b5e..18ec67d7 100644 --- a/massiv-bench/bench/Mutable.hs +++ b/massiv-bench/bench/Mutable.hs @@ -20,7 +20,7 @@ main = do mkBench :: - forall r. (Construct r Ix2 Double, Mutable r Double) + forall r. (Load r Ix2 Double, Mutable r Double) => Sz2 -> r -> IO [Benchmark] diff --git a/massiv-bench/src/Data/Massiv/Bench.hs b/massiv-bench/src/Data/Massiv/Bench.hs index 5226ef48..1cea959a 100644 --- a/massiv-bench/src/Data/Massiv/Bench.hs +++ b/massiv-bench/src/Data/Massiv/Bench.hs @@ -32,11 +32,11 @@ lightFuncIx1 :: Int -- ^ cols lightFuncIx1 k i = lightFuncIx2T (divMod i k) {-# INLINE lightFuncIx1 #-} -arrRLightIx2 :: Construct r Ix2 Double => r -> Comp -> Sz2 -> Array r Ix2 Double +arrRLightIx2 :: Load r Ix2 Double => r -> Comp -> Sz2 -> Matrix r Double arrRLightIx2 _ comp arrSz = makeArray comp arrSz (\ (i :. j) -> lightFunc i j) {-# INLINE arrRLightIx2 #-} -arrRHeavyIx2 :: Construct r Ix2 Double => r -> Comp -> Sz2 -> Array r Ix2 Double +arrRHeavyIx2 :: Load r Ix2 Double => r -> Comp -> Sz2 -> Matrix r Double arrRHeavyIx2 _ comp arrSz = makeArray comp arrSz (\ (i :. j) -> heavyFunc i j) {-# INLINE arrRHeavyIx2 #-} diff --git a/massiv-bench/src/Data/Massiv/Bench/Matrix.hs b/massiv-bench/src/Data/Massiv/Bench/Matrix.hs index 81900e54..ddbe171e 100644 --- a/massiv-bench/src/Data/Massiv/Bench/Matrix.hs +++ b/massiv-bench/src/Data/Massiv/Bench/Matrix.hs @@ -101,7 +101,7 @@ showSizeMxV MxV {..} = show m1 <> "x" <> show n1 <> " X " <> show n <> "x1" benchMxV :: - forall r e. (Typeable r, Typeable e, Numeric r e, Mutable r e) + forall r e. (Typeable r, Typeable e, Numeric r e, Mutable r e, Load r Ix2 e) => MxV r e -> Benchmark benchMxV mxv@MxV {..} = diff --git a/massiv-examples/GameOfLife/app/GameOfLife.hs b/massiv-examples/GameOfLife/app/GameOfLife.hs index bffd496d..41bfed5c 100644 --- a/massiv-examples/GameOfLife/app/GameOfLife.hs +++ b/massiv-examples/GameOfLife/app/GameOfLife.hs @@ -101,7 +101,7 @@ startGameOfLife sz s = do let iLife = initLife sz inf2 wSz = size (pixelGrid s iLife) G.windowSize $= sizeFromSz2 wSz - mArr <- new wSz + mArr <- newMArray' wSz displayCallback $= clear [ColorBuffer] drawLife s mArr iLife runGameOfLife s mArr iLife diff --git a/massiv-examples/examples/src/Examples/SortRows.hs b/massiv-examples/examples/src/Examples/SortRows.hs index 21d507b2..ce546344 100644 --- a/massiv-examples/examples/src/Examples/SortRows.hs +++ b/massiv-examples/examples/src/Examples/SortRows.hs @@ -16,14 +16,14 @@ sortRows :: forall r e v. ( Ord e , Typeable v - , A.Construct r Ix2 e - , A.Mutable r Ix2 e + , A.Load r Ix2 e + , A.Mutable r e , VG.Vector v e , ARepr v ~ r , VRepr r ~ v ) - => Array r Ix2 e - -> Array r Ix2 e + => Matrix r e + -> Matrix r e sortRows arr = unsafePerformIO $ do mv :: VG.Mutable v RealWorld e <- VG.thaw (A.toVector arr :: v e) let comp = getComp arr diff --git a/massiv-examples/stack.yaml b/massiv-examples/stack.yaml index 33994283..a4d74b82 100644 --- a/massiv-examples/stack.yaml +++ b/massiv-examples/stack.yaml @@ -6,8 +6,12 @@ packages: - examples extra-deps: - ../massiv +- ../../massiv-io/massiv-io - Color-0.3.1@sha256:980a3869e25cbe91275113dd3273465e373b06d710c9e4ef3e0f07ec77815165,8193 -- massiv-io-0.4.1.0@sha256:fd1db3d851e0343833b8b3b6526be0f05782ee1f2152788616d71108d3b9676f,3667 +#- massiv-io-0.4.1.0@sha256:fd1db3d851e0343833b8b3b6526be0f05782ee1f2152788616d71108d3b9676f,3667 - scheduler-1.5.0@sha256:8b43f2991bf9a720b12192ba99525f705a44aeae9541a7bd73fbc7e7b56fd8f0,2437 +- random-1.2.0@sha256:5ca8674e95c46c7eb90f520c26aea22d403625c97697275434afba66ebd32b05,5897 +- splitmix-0.1.0.3@sha256:fc3aae74c467f4b608050bef53aec17904a618731df9407e655d8f3bf8c32d5c,6049 +- QuickCheck-2.14.1@sha256:01e46d7b0a8d3148288ec977625f62d5516ebb5031a50c63f0453863301b4a79,7736 nix: packages: [ zlib libGLU ] diff --git a/massiv-examples/vision/app/MakeFilter.hs b/massiv-examples/vision/app/MakeFilter.hs index 7d66512a..8d27e14a 100644 --- a/massiv-examples/vision/app/MakeFilter.hs +++ b/massiv-examples/vision/app/MakeFilter.hs @@ -16,7 +16,7 @@ gaussian1 stdDev x = exp (- (x ^ (2 :: Int)) / var2) / (sqrt (var2 * pi)) var2 = 2 * stdDev ^ (2 :: Int) {-# INLINE gaussian1 #-} -mkGaussian2 :: Int -> Int -> Array M Ix2 Double +mkGaussian2 :: Int -> Int -> Array D Ix2 Double mkGaussian2 n side = let f scale (i :. j) = gaussian2 (1 :: Double) (scale i) (scale j) {-# INLINE f #-} @@ -27,7 +27,7 @@ mkGaussian2 n side = {-# INLINE mkGaussian2 #-} -mkGaussian1 :: Int -> Int -> Array M Ix2 Double +mkGaussian1 :: Int -> Int -> Array D Ix2 Double mkGaussian1 n side = let f scale i = gaussian1 (1 :: Double) (scale i) {-# INLINE f #-} diff --git a/massiv-examples/vision/vision.cabal b/massiv-examples/vision/vision.cabal index 20436c21..1d72f9db 100644 --- a/massiv-examples/vision/vision.cabal +++ b/massiv-examples/vision/vision.cabal @@ -22,8 +22,8 @@ executable vision ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.7 && <5 - , massiv - , massiv-io + , massiv >= 1.0.0 + , massiv-io >= 1.0.0 default-language: Haskell2010 executable avg-sum diff --git a/stack.yaml b/stack.yaml index 8e163472..35c0ebf4 100644 --- a/stack.yaml +++ b/stack.yaml @@ -6,7 +6,7 @@ flags: {} extra-deps: - primitive-0.7.1.0 - pvar-1.0.0.0@sha256:3d4a6855b0960baee78f6956f082eb8aa1cede52d2955b7faef186d1133f7964,1893 -- scheduler-1.5.0 +- scheduler-1.5.0@sha256:8b43f2991bf9a720b12192ba99525f705a44aeae9541a7bd73fbc7e7b56fd8f0,2437 - random-1.2.0@sha256:5ca8674e95c46c7eb90f520c26aea22d403625c97697275434afba66ebd32b05,5897 - splitmix-0.1.0.3@sha256:fc3aae74c467f4b608050bef53aec17904a618731df9407e655d8f3bf8c32d5c,6049 - QuickCheck-2.14.1@sha256:01e46d7b0a8d3148288ec977625f62d5516ebb5031a50c63f0453863301b4a79,7736 From 09b8d73c881bf8dbbb655640cab694919b181f85 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Thu, 22 Apr 2021 19:08:44 +0300 Subject: [PATCH 16/65] Addition of `isZeroSz` and `isNotZeroSz` --- massiv/CHANGELOG.md | 1 + massiv/src/Data/Massiv/Core/Common.hs | 4 ++-- massiv/src/Data/Massiv/Core/Index.hs | 28 ++++++++++++++++++++------- 3 files changed, 24 insertions(+), 9 deletions(-) diff --git a/massiv/CHANGELOG.md b/massiv/CHANGELOG.md index df81236c..edfcd619 100644 --- a/massiv/CHANGELOG.md +++ b/massiv/CHANGELOG.md @@ -1,5 +1,6 @@ # 1.0.0 +* Replace `isNonEmpty` with `isNotZeroSz` and added `isZeroSz` * Consolidate `Construct` class into `Load` * Get rid of `M` representation * Introduce `Shape`, the parent of `Size` diff --git a/massiv/src/Data/Massiv/Core/Common.hs b/massiv/src/Data/Massiv/Core/Common.hs index d92ff086..b7cb9c78 100644 --- a/massiv/src/Data/Massiv/Core/Common.hs +++ b/massiv/src/Data/Massiv/Core/Common.hs @@ -707,10 +707,10 @@ class Load r ix e => Ragged r ix e where generateRaggedM :: Monad m => Comp -> Sz ix -> (ix -> m e) -> m (Array r ix e) - flattenRagged :: Array r ix e -> Array r Ix1 e + flattenRagged :: Array r ix e -> Vector r e loadRagged :: - Monad m => (m () -> m ()) -> (Int -> e -> m a) -> Int -> Int -> Sz ix -> Array r ix e -> m () + Monad m => (m () -> m ()) -> (Ix1 -> e -> m a) -> Ix1 -> Ix1 -> Sz ix -> Array r ix e -> m () raggedFormat :: (e -> String) -> String -> Array r ix e -> String diff --git a/massiv/src/Data/Massiv/Core/Index.hs b/massiv/src/Data/Massiv/Core/Index.hs index b88249a1..5467b162 100644 --- a/massiv/src/Data/Massiv/Core/Index.hs +++ b/massiv/src/Data/Massiv/Core/Index.hs @@ -64,7 +64,8 @@ module Data.Massiv.Core.Index , Index(..) , zeroIndex , oneIndex - , isNonEmpty + , isZeroSz + , isNonZeroSz , headDim , tailDim , lastDim @@ -213,22 +214,35 @@ oneIndex :: Index ix => ix oneIndex = pureIndex 1 {-# INLINE [1] oneIndex #-} --- | Checks whether array with this size can hold at least one element. +-- | Checks whether size can hold at least one element. -- -- ==== __Examples__ -- --- >>> isNonEmpty (Sz3 1 0 2) +-- >>> isNonZeroSz (Sz3 1 0 2) -- False -- --- @since 0.1.0 -isNonEmpty :: Index ix => Sz ix -> Bool -isNonEmpty !sz = isSafeIndex sz zeroIndex -{-# INLINE [1] isNonEmpty #-} +-- @since 1.0.0 +isNonZeroSz :: Index ix => Sz ix -> Bool +isNonZeroSz !sz = isSafeIndex sz zeroIndex +{-# INLINE [1] isNonZeroSz #-} -- TODO: benchmark against (also adjust `isEmpty` with fastest): -- - foldlIndex (*) 1 (unSz sz) /= 0 -- - foldlIndex (\a x -> a && x /= 0) True (unSz sz) -- - totalElem sz == 0 +-- | Checks whether size can hold at least one element. +-- +-- ==== __Examples__ +-- +-- >>> isNonZeroSz (Sz3 1 0 2) +-- False +-- +-- @since 1.0.0 +isZeroSz :: Index ix => Sz ix -> Bool +isZeroSz = not . isNonZeroSz +{-# INLINE [1] isZeroSz #-} + + -- | Convert a size to a linear size. -- -- @since 0.5.8 From b6b5881ad2dd696f8e502c76567fc87968109dc3 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Thu, 22 Apr 2021 21:53:28 +0300 Subject: [PATCH 17/65] Fix isNull for L and LN --- massiv/src/Data/Massiv/Core/List.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/massiv/src/Data/Massiv/Core/List.hs b/massiv/src/Data/Massiv/Core/List.hs index 91a03b6e..d6d6296f 100644 --- a/massiv/src/Data/Massiv/Core/List.hs +++ b/massiv/src/Data/Massiv/Core/List.hs @@ -140,7 +140,7 @@ instance Shape LN Ix2 where {-# INLINE linearSize #-} linearSizeHint = lengthHintList . unList {-# INLINE linearSizeHint #-} - isNull = null . unList + isNull = getAll . foldMap (All . null . unList) . unList {-# INLINE isNull #-} outerSize arr = case unList arr of @@ -163,7 +163,7 @@ instance (Shape LN (Ix (n - 1)), Index (IxN n)) => Shape LN (IxN n) where {-# INLINE linearSize #-} linearSizeHint = lengthHintList . unList {-# INLINE linearSizeHint #-} - isNull = null . unList + isNull = getAll . foldMap (All . isNull) . unList {-# INLINE isNull #-} outerSize arr = case unList arr of From 908fc4ac84702fdda0b1858f728d7a4dd1fda542 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Thu, 22 Apr 2021 22:09:16 +0300 Subject: [PATCH 18/65] Switch loadRagged to use scheduler --- massiv/src/Data/Massiv/Core/Common.hs | 4 ++-- massiv/src/Data/Massiv/Core/List.hs | 14 +++++++------- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/massiv/src/Data/Massiv/Core/Common.hs b/massiv/src/Data/Massiv/Core/Common.hs index b7cb9c78..15e84aac 100644 --- a/massiv/src/Data/Massiv/Core/Common.hs +++ b/massiv/src/Data/Massiv/Core/Common.hs @@ -709,8 +709,8 @@ class Load r ix e => Ragged r ix e where flattenRagged :: Array r ix e -> Vector r e - loadRagged :: - Monad m => (m () -> m ()) -> (Ix1 -> e -> m a) -> Ix1 -> Ix1 -> Sz ix -> Array r ix e -> m () + loadRagged :: Monad m => + Scheduler m () -> (Ix1 -> e -> m a) -> Ix1 -> Ix1 -> Sz ix -> Array r ix e -> m () raggedFormat :: (e -> String) -> String -> Array r ix e -> String diff --git a/massiv/src/Data/Massiv/Core/List.hs b/massiv/src/Data/Massiv/Core/List.hs index d6d6296f..c5509d73 100644 --- a/massiv/src/Data/Massiv/Core/List.hs +++ b/massiv/src/Data/Massiv/Core/List.hs @@ -205,8 +205,8 @@ instance Ragged L Ix1 e where return (e:acc) return $ LArray comp $ coerce xs {-# INLINE generateRaggedM #-} - loadRagged using uWrite start end sz xs = - using $ do + loadRagged scheduler uWrite start end sz xs = + scheduleWork scheduler $ do leftOver <- loopM start (< end) (+ 1) xs $ \i xs' -> case unconsR xs' of @@ -221,7 +221,7 @@ instance (Shape L ix, Ragged L ix e) => Load L ix e where makeArray comp sz f = runIdentity $ generateRaggedM comp sz (pure . f) {-# INLINE makeArray #-} loadArrayM scheduler arr uWrite = - loadRagged (scheduleWork scheduler) uWrite 0 (totalElem sz) sz arr + loadRagged scheduler uWrite 0 (totalElem sz) sz arr where !sz = outerSize arr {-# INLINE loadArrayM #-} @@ -246,7 +246,7 @@ instance Ragged L Ix2 e where where xs = concatMap (unList . lData . flattenRagged . LArray (lComp arr)) (unList (lData arr)) {-# INLINE flattenRagged #-} - loadRagged using uWrite start end sz xs = do + loadRagged scheduler uWrite start end sz xs = do let (k, szL) = unconsSz sz step = totalElem szL isZero = totalElem sz == 0 @@ -257,7 +257,7 @@ instance Ragged L Ix2 e where case unconsR zs of Nothing -> return $! throw (DimTooShortException k (outerLength xs)) Just (y, ys) -> do - _ <- loadRagged using uWrite i (i + step) szL y + _ <- loadRagged scheduler uWrite i (i + step) szL y return ys unless (isNull leftOver) (return $! throw DimTooLongException) {-# INLINE loadRagged #-} @@ -287,7 +287,7 @@ instance (Shape L (IxN n), Shape LN (Ix (n - 1)), Ragged L (Ix (n - 1)) e) => where xs = concatMap (unList . lData . flattenRagged . LArray (lComp arr)) (unList (lData arr)) {-# INLINE flattenRagged #-} - loadRagged using uWrite start end sz xs = do + loadRagged scheduler uWrite start end sz xs = do let (k, szL) = unconsSz sz step = totalElem szL isZero = totalElem sz == 0 @@ -298,7 +298,7 @@ instance (Shape L (IxN n), Shape LN (Ix (n - 1)), Ragged L (Ix (n - 1)) e) => case unconsR zs of Nothing -> return $! throw (DimTooShortException k (outerLength xs)) Just (y, ys) -> do - _ <- loadRagged using uWrite i (i + step) szL y + _ <- loadRagged scheduler uWrite i (i + step) szL y return ys unless (isNull leftOver) (return $! throw DimTooLongException) {-# INLINE loadRagged #-} From 220fac9ccd3e7853618d4b501c754261d7f2ac67 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sat, 19 Jun 2021 00:18:25 +0300 Subject: [PATCH 19/65] Fix compilation error --- massiv-test/src/Test/Massiv/Core/Index.hs | 4 ++-- massiv/CHANGELOG.md | 2 +- massiv/src/Data/Massiv/Array/Manifest/Internal.hs | 2 +- massiv/src/Data/Massiv/Core/Index.hs | 4 ++-- shell.nix | 2 +- stack.yaml | 7 ++----- 6 files changed, 9 insertions(+), 12 deletions(-) diff --git a/massiv-test/src/Test/Massiv/Core/Index.hs b/massiv-test/src/Test/Massiv/Core/Index.hs index bd5cc6fa..4e522b97 100644 --- a/massiv-test/src/Test/Massiv/Core/Index.hs +++ b/massiv-test/src/Test/Massiv/Core/Index.hs @@ -538,8 +538,8 @@ szSpec = do describe "Number of Elements" $ do it "TotalElem" $ property $ \(sz :: Sz ix) -> totalElem sz === foldlIndex (*) 1 (unSz sz) - it "IsNonEmpty" $ property $ - \(sz :: Sz ix) -> isNonEmpty sz === foldlIndex (\a x -> a && x > 0) True (unSz sz) + it "IsNonZeroSz" $ property $ + \(sz :: Sz ix) -> isNonZeroSz sz === foldlIndex (\a x -> a && x > 0) True (unSz sz) describe "Iterators" $ do it "IterLinearM" $ property $ prop_IterLinearM @ix it "IterLinearM_" $ property $ prop_IterLinearM_ @ix diff --git a/massiv/CHANGELOG.md b/massiv/CHANGELOG.md index edfcd619..0dc44c47 100644 --- a/massiv/CHANGELOG.md +++ b/massiv/CHANGELOG.md @@ -1,6 +1,6 @@ # 1.0.0 -* Replace `isNonEmpty` with `isNotZeroSz` and added `isZeroSz` +* Replace `isNonEmpty` with `isNonZeroSz` and added `isZeroSz` * Consolidate `Construct` class into `Load` * Get rid of `M` representation * Introduce `Shape`, the parent of `Size` diff --git a/massiv/src/Data/Massiv/Array/Manifest/Internal.hs b/massiv/src/Data/Massiv/Array/Manifest/Internal.hs index 8dc877cc..3dd3adee 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Internal.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Internal.hs @@ -226,7 +226,7 @@ fromRaggedArrayM arr = marr <- unsafeNew sz traverse (\_ -> unsafeFreeze (getComp arr) marr) =<< try (withMassivScheduler_ (getComp arr) $ \scheduler -> - loadRagged (scheduleWork scheduler) (unsafeLinearWrite marr) 0 (totalElem sz) sz arr) + loadRagged scheduler (unsafeLinearWrite marr) 0 (totalElem sz) sz arr) {-# INLINE fromRaggedArrayM #-} diff --git a/massiv/src/Data/Massiv/Core/Index.hs b/massiv/src/Data/Massiv/Core/Index.hs index 5467b162..c7bd1bee 100644 --- a/massiv/src/Data/Massiv/Core/Index.hs +++ b/massiv/src/Data/Massiv/Core/Index.hs @@ -234,8 +234,8 @@ isNonZeroSz !sz = isSafeIndex sz zeroIndex -- -- ==== __Examples__ -- --- >>> isNonZeroSz (Sz3 1 0 2) --- False +-- >>> isZeroSz (Sz3 1 0 2) +-- True -- -- @since 1.0.0 isZeroSz :: Index ix => Sz ix -> Bool diff --git a/shell.nix b/shell.nix index 1f2e5742..3907cbe3 100644 --- a/shell.nix +++ b/shell.nix @@ -13,6 +13,6 @@ let }; in pkgs.mkShell { - buildInputs = [ stack pkgs.haskellPackages.ghcid pkgs.haskell.compiler.ghc822 pkgs.gmp ]; + buildInputs = [ stack pkgs.haskellPackages.ghcid pkgs.haskell.compiler.ghc8104 pkgs.gmp ]; } diff --git a/stack.yaml b/stack.yaml index 35c0ebf4..f7d9aa40 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,12 +1,9 @@ -resolver: lts-16.31 +resolver: lts-17.15 packages: - 'massiv/' - 'massiv-test/' flags: {} extra-deps: -- primitive-0.7.1.0 -- pvar-1.0.0.0@sha256:3d4a6855b0960baee78f6956f082eb8aa1cede52d2955b7faef186d1133f7964,1893 -- scheduler-1.5.0@sha256:8b43f2991bf9a720b12192ba99525f705a44aeae9541a7bd73fbc7e7b56fd8f0,2437 - random-1.2.0@sha256:5ca8674e95c46c7eb90f520c26aea22d403625c97697275434afba66ebd32b05,5897 -- splitmix-0.1.0.3@sha256:fc3aae74c467f4b608050bef53aec17904a618731df9407e655d8f3bf8c32d5c,6049 - QuickCheck-2.14.1@sha256:01e46d7b0a8d3148288ec977625f62d5516ebb5031a50c63f0453863301b4a79,7736 +- scheduler-1.5.0@sha256:8b43f2991bf9a720b12192ba99525f705a44aeae9541a7bd73fbc7e7b56fd8f0,2437 From 90d88497b91951e35fc2b3c3c4a9559f63b1e4cf Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sat, 19 Jun 2021 00:49:51 +0300 Subject: [PATCH 20/65] Export Add `uniformArray` and `uniformRangeArray` --- massiv/CHANGELOG.md | 1 + massiv/src/Data/Massiv/Array/Ops/Construct.hs | 2 ++ stack-extra-deps.yaml | 7 +++++-- 3 files changed, 8 insertions(+), 2 deletions(-) diff --git a/massiv/CHANGELOG.md b/massiv/CHANGELOG.md index 0dc44c47..7590042e 100644 --- a/massiv/CHANGELOG.md +++ b/massiv/CHANGELOG.md @@ -1,5 +1,6 @@ # 1.0.0 +* Add `uniformArray` and `uniformRangeArray` * Replace `isNonEmpty` with `isNonZeroSz` and added `isZeroSz` * Consolidate `Construct` class into `Load` * Get rid of `M` representation diff --git a/massiv/src/Data/Massiv/Array/Ops/Construct.hs b/massiv/src/Data/Massiv/Array/Ops/Construct.hs index cc6f1e14..4ddf2ebd 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Construct.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Construct.hs @@ -37,6 +37,8 @@ module Data.Massiv.Array.Ops.Construct , iunfoldrS_ --, iunfoldrS -- *** Random + , uniformArray + , uniformRangeArray , randomArray , randomArrayS , randomArrayWS diff --git a/stack-extra-deps.yaml b/stack-extra-deps.yaml index 5803d07a..5e4fd5ca 100644 --- a/stack-extra-deps.yaml +++ b/stack-extra-deps.yaml @@ -4,8 +4,11 @@ packages: - 'massiv-test/' flags: {} extra-deps: -- unliftio-0.2.12@sha256:b089fbc2ff2628a963c2c4b12143f2020874e3e5144ffd6c62b25639a0ca1483,3325 +- unliftio-0.2.18@sha256:87fb541127d21939d3efc49ed9bc3df6eadc9eb06ffa7755fc857f62e15daf20,3395 - pvar-1.0.0.0@sha256:3d4a6855b0960baee78f6956f082eb8aa1cede52d2955b7faef186d1133f7964,1893 - primitive-0.7.1.0@sha256:6a237bb338bcc43193077ff8e8c0f0ce2de14c652231496a15672e8b563a07e2,2604 - scheduler-1.5.0@sha256:8b43f2991bf9a720b12192ba99525f705a44aeae9541a7bd73fbc7e7b56fd8f0,2437 -- vector-0.12.1.2@sha256:9291bc581f36e51d5bda9fce57cb980fbec3dd292996896f285fef39eb80a9a0,7364 +- vector-0.12.3.0@sha256:0ae2c1ba86f0077910be242ec6802cc3d7725fe7b2bea6987201aa3737b239b5,7953 +- random-1.2.0@sha256:5ca8674e95c46c7eb90f520c26aea22d403625c97697275434afba66ebd32b05,5897 +- QuickCheck-2.14.1@sha256:01e46d7b0a8d3148288ec977625f62d5516ebb5031a50c63f0453863301b4a79,7736 +- splitmix-0.1.0.3@sha256:fc3aae74c467f4b608050bef53aec17904a618731df9407e655d8f3bf8c32d5c,6049 From a0bd0e6200edbd7f7c9ed076835b305e29ff6e0e Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sat, 19 Jun 2021 01:59:16 +0300 Subject: [PATCH 21/65] Add proper mwc-random doctested example. Export forgotten new addition Strategy. Rename isNotZeroSz --- README.md | 5 --- massiv-test/src/Test/Massiv/Core/Index.hs | 2 +- massiv/CHANGELOG.md | 3 +- massiv/massiv.cabal | 5 ++- massiv/src/Data/Massiv/Array.hs | 7 ++-- massiv/src/Data/Massiv/Array/Ops/Construct.hs | 38 ++++++++++--------- massiv/src/Data/Massiv/Array/Unsafe.hs | 1 + massiv/src/Data/Massiv/Core.hs | 1 + massiv/src/Data/Massiv/Core/Index.hs | 12 +++--- stack-extra-deps.yaml | 3 +- stack.yaml | 7 +--- 11 files changed, 42 insertions(+), 42 deletions(-) diff --git a/README.md b/README.md index d67184b2..02fbaacf 100644 --- a/README.md +++ b/README.md @@ -48,11 +48,6 @@ from the end, are: * `N` - Also boxed arrays, but unlike the other representation `B`, its elements are in Normal Form, i.e. in a fully evaluated state and no thunks or memory leaks are possible. It does require `NFData` instance for the elements though. - * `M` - Manifest arrays, which is a general type of array that is backed by some memory - representation, therefore any of the above `P`, `U`, `S`, `B` type of arrays can be converted - to `M` in constant time with `toManifest` function. It is mostly useful during constant time - slicing of manifest arrays, as this becomes the result representation. More on that in the - [slicing](#slicing) section. ## Construct diff --git a/massiv-test/src/Test/Massiv/Core/Index.hs b/massiv-test/src/Test/Massiv/Core/Index.hs index 4e522b97..1374fa39 100644 --- a/massiv-test/src/Test/Massiv/Core/Index.hs +++ b/massiv-test/src/Test/Massiv/Core/Index.hs @@ -539,7 +539,7 @@ szSpec = do it "TotalElem" $ property $ \(sz :: Sz ix) -> totalElem sz === foldlIndex (*) 1 (unSz sz) it "IsNonZeroSz" $ property $ - \(sz :: Sz ix) -> isNonZeroSz sz === foldlIndex (\a x -> a && x > 0) True (unSz sz) + \(sz :: Sz ix) -> isNotZeroSz sz === foldlIndex (\a x -> a && x > 0) True (unSz sz) describe "Iterators" $ do it "IterLinearM" $ property $ prop_IterLinearM @ix it "IterLinearM_" $ property $ prop_IterLinearM_ @ix diff --git a/massiv/CHANGELOG.md b/massiv/CHANGELOG.md index 7590042e..426dd8fd 100644 --- a/massiv/CHANGELOG.md +++ b/massiv/CHANGELOG.md @@ -1,7 +1,8 @@ # 1.0.0 +* Add of `munsafeResize` * Add `uniformArray` and `uniformRangeArray` -* Replace `isNonEmpty` with `isNonZeroSz` and added `isZeroSz` +* Replace `isNonEmpty` with `isNotZeroSz` and added `isZeroSz` * Consolidate `Construct` class into `Load` * Get rid of `M` representation * Introduce `Shape`, the parent of `Size` diff --git a/massiv/massiv.cabal b/massiv/massiv.cabal index 9c3669d2..dc74308b 100644 --- a/massiv/massiv.cabal +++ b/massiv/massiv.cabal @@ -83,7 +83,7 @@ library , exceptions , scheduler >= 1.5.0 , primitive - , random + , random >= 1.2.0 , unliftio-core , vector @@ -108,7 +108,8 @@ test-suite doctests , QuickCheck , massiv , mersenne-random-pure64 - , random + , random >= 1.2.0 + , mwc-random >= 0.15.0.1 , splitmix >= 0.0.1 , template-haskell default-language: Haskell2010 diff --git a/massiv/src/Data/Massiv/Array.hs b/massiv/src/Data/Massiv/Array.hs index da3528ad..6f135601 100644 --- a/massiv/src/Data/Massiv/Array.hs +++ b/massiv/src/Data/Massiv/Array.hs @@ -24,7 +24,8 @@ -- Form (NF). This property is very useful for parallel processing, i.e. when calling -- `compute` you do want all of your elements to be fully evaluated. -- --- * `BL` - Similar to `B`, is also a boxed type, but lazy. It's elements are not evaluated. +-- * `BL` - Similar to `B`, is also a boxed type, but lazy. It's elements are not evaluated when +-- array is computed. -- -- * `S` - Is a type of array that is backed by pinned memory, therefore pointers to those arrays -- can be passed to FFI calls, because Garbage Collector (GC) is guaranteed not to move @@ -36,9 +37,6 @@ -- * `P` - Array that can hold Haskell primitives, such as `Int`, `Word`, `Double`, etc. Any element -- must be an instance of `Prim` class. -- --- * `M` - General manifest array type, that any of the above representations can be converted to in --- constant time using `toManifest`. --- -- There are also array representations that only describe how values for its elements can be -- computed or loaded into memory, as such, they are represented by functions and do not impose the -- memory overhead, that is normally associated with arrays. They are needed for proper fusion and @@ -85,6 +83,7 @@ module Data.Massiv.Array -- * Compute , getComp , setComp + , appComp , compute , computeS , computeP diff --git a/massiv/src/Data/Massiv/Array/Ops/Construct.hs b/massiv/src/Data/Massiv/Array/Ops/Construct.hs index 4ddf2ebd..b61f7520 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Construct.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Construct.hs @@ -343,7 +343,7 @@ randomArray gen splitGen nextRandom comp sz = unsafeMakeLoadArray comp sz Nothin -- @since 1.0.0 uniformArray :: forall ix e g. (Index ix, RandomGen g, Uniform e) - => g -- ^ Initial random value generator + => g -- ^ Initial random value generator. -> Comp -- ^ Computation strategy. -> Sz ix -- ^ Resulting size of the array. -> Array DL ix e @@ -354,8 +354,8 @@ uniformArray gen = randomArray gen split uniform -- @since 1.0.0 uniformRangeArray :: forall ix e g. (Index ix, RandomGen g, UniformRange e) - => g -- ^ Initial random value generator - -> (e, e) + => g -- ^ Initial random value generator. + -> (e, e) -- ^ Inclusive range in which values will be generated in. -> Comp -- ^ Computation strategy. -> Sz ix -- ^ Resulting size of the array. -> Array DL ix e @@ -420,20 +420,24 @@ randomArrayS gen sz nextRandom = -- -- In the example below we take a stateful random number generator from -- [wmc-random](https://www.stackage.org/package/mwc-random), which is not thread safe, --- and safely parallelize it by giving each thread it's own generator: --- --- > λ> import Data.Massiv.Array --- > λ> import System.Random.MWC (createSystemRandom, uniformR) --- > λ> import System.Random.MWC.Distributions (standard) --- > λ> gens <- initWorkerStates Par (\_ -> createSystemRandom) --- > λ> randomArrayWS gens (Sz2 2 3) standard :: IO (Array P Ix2 Double) --- > Array P Par (Sz (2 :. 3)) --- > [ [ -0.9066144845415213, 0.5264323240310042, -1.320943607597422 ] --- > , [ -0.6837929005619592, -0.3041255565826211, 6.53353089112833e-2 ] --- > ] --- > λ> randomArrayWS gens (Sz1 10) (uniformR (0, 9)) :: IO (Array P Ix1 Int) --- > Array P Par (Sz1 10) --- > [ 3, 6, 1, 2, 1, 7, 6, 0, 8, 8 ] +-- and safely parallelize it by giving each thread it's own generator. There is a caveat +-- of course, statistical independence will depend on the entropy in your initial seeds, +-- so do not use the example below verbatim, since intiial seeds are sequential numbers. +-- +-- >>> import Data.Massiv.Array as A +-- >>> import System.Random.MWC as MWC (initialize) +-- >>> import System.Random.Stateful (uniformRM) +-- >>> import Control.Scheduler (initWorkerStates, getWorkerId) +-- >>> :set -XTypeApplications +-- >>> gens <- initWorkerStates (ParN 3) (MWC.initialize . A.toPrimitiveVector . A.singleton @P @Ix1 . fromIntegral . getWorkerId) +-- >>> randomArrayWS gens (Sz2 2 3) (uniformRM (0, 9)) :: IO (Array P Ix2 Double) +-- Array P Par (Sz (2 :. 3)) +-- [ [ 2.5438514691269685, 4.287612444807011, 5.610339021582389 ] +-- , [ 4.697970155404468, 5.00119167394813, 2.996037154611197 ] +-- ] +-- >>> randomArrayWS gens (Sz1 10) (uniformRM (0, 9)) :: IO (Vector P Int) +-- Array P Par (Sz1 10) +-- [ 0, 9, 3, 2, 2, 7, 6, 7, 7, 5 ] -- -- @since 0.3.4 randomArrayWS :: diff --git a/massiv/src/Data/Massiv/Array/Unsafe.hs b/massiv/src/Data/Massiv/Array/Unsafe.hs index 298c5b23..6e25e96e 100644 --- a/massiv/src/Data/Massiv/Array/Unsafe.hs +++ b/massiv/src/Data/Massiv/Array/Unsafe.hs @@ -32,6 +32,7 @@ module Data.Massiv.Array.Unsafe , unsafeInnerSlice , unsafeLinearSlice -- * Mutable interface + , munsafeResize , unsafeThaw , unsafeFreeze , unsafeNew diff --git a/massiv/src/Data/Massiv/Core.hs b/massiv/src/Data/Massiv/Core.hs index de9f25f0..61109564 100644 --- a/massiv/src/Data/Massiv/Core.hs +++ b/massiv/src/Data/Massiv/Core.hs @@ -30,6 +30,7 @@ module Data.Massiv.Core , ListItem , Scheduler , SchedulerWS + , Strategy , Comp(Seq, Par, Par', ParOn, ParN) , appComp , WorkerStates diff --git a/massiv/src/Data/Massiv/Core/Index.hs b/massiv/src/Data/Massiv/Core/Index.hs index c7bd1bee..5252aaae 100644 --- a/massiv/src/Data/Massiv/Core/Index.hs +++ b/massiv/src/Data/Massiv/Core/Index.hs @@ -65,7 +65,7 @@ module Data.Massiv.Core.Index , zeroIndex , oneIndex , isZeroSz - , isNonZeroSz + , isNotZeroSz , headDim , tailDim , lastDim @@ -218,13 +218,13 @@ oneIndex = pureIndex 1 -- -- ==== __Examples__ -- --- >>> isNonZeroSz (Sz3 1 0 2) +-- >>> isNotZeroSz (Sz3 1 0 2) -- False -- -- @since 1.0.0 -isNonZeroSz :: Index ix => Sz ix -> Bool -isNonZeroSz !sz = isSafeIndex sz zeroIndex -{-# INLINE [1] isNonZeroSz #-} +isNotZeroSz :: Index ix => Sz ix -> Bool +isNotZeroSz !sz = isSafeIndex sz zeroIndex +{-# INLINE [1] isNotZeroSz #-} -- TODO: benchmark against (also adjust `isEmpty` with fastest): -- - foldlIndex (*) 1 (unSz sz) /= 0 -- - foldlIndex (\a x -> a && x /= 0) True (unSz sz) @@ -239,7 +239,7 @@ isNonZeroSz !sz = isSafeIndex sz zeroIndex -- -- @since 1.0.0 isZeroSz :: Index ix => Sz ix -> Bool -isZeroSz = not . isNonZeroSz +isZeroSz = not . isNotZeroSz {-# INLINE [1] isZeroSz #-} diff --git a/stack-extra-deps.yaml b/stack-extra-deps.yaml index 5e4fd5ca..89549c75 100644 --- a/stack-extra-deps.yaml +++ b/stack-extra-deps.yaml @@ -10,5 +10,6 @@ extra-deps: - scheduler-1.5.0@sha256:8b43f2991bf9a720b12192ba99525f705a44aeae9541a7bd73fbc7e7b56fd8f0,2437 - vector-0.12.3.0@sha256:0ae2c1ba86f0077910be242ec6802cc3d7725fe7b2bea6987201aa3737b239b5,7953 - random-1.2.0@sha256:5ca8674e95c46c7eb90f520c26aea22d403625c97697275434afba66ebd32b05,5897 -- QuickCheck-2.14.1@sha256:01e46d7b0a8d3148288ec977625f62d5516ebb5031a50c63f0453863301b4a79,7736 +- mwc-random-0.15.0.1@sha256:48e4b01a7447671b8bd13957de65f19ef41ee0376083c0c501e179e68768276a,3372 +- QuickCheck-2.14.2@sha256:4ce29211223d5e6620ebceba34a3ca9ccf1c10c0cf387d48aea45599222ee5aa,7736 - splitmix-0.1.0.3@sha256:fc3aae74c467f4b608050bef53aec17904a618731df9407e655d8f3bf8c32d5c,6049 diff --git a/stack.yaml b/stack.yaml index f7d9aa40..5768aafe 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,9 +1,6 @@ -resolver: lts-17.15 +resolver: lts-18.0 packages: - 'massiv/' - 'massiv-test/' flags: {} -extra-deps: -- random-1.2.0@sha256:5ca8674e95c46c7eb90f520c26aea22d403625c97697275434afba66ebd32b05,5897 -- QuickCheck-2.14.1@sha256:01e46d7b0a8d3148288ec977625f62d5516ebb5031a50c63f0453863301b4a79,7736 -- scheduler-1.5.0@sha256:8b43f2991bf9a720b12192ba99525f705a44aeae9541a7bd73fbc7e7b56fd8f0,2437 +extra-deps: [] From 974347d9e6ed76426ea1e944aba5b37c6ca67c73 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sat, 19 Jun 2021 02:01:17 +0300 Subject: [PATCH 22/65] Adjust github actions --- .github/workflows/haskell.yml | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index d4a2390a..711054cf 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -27,15 +27,18 @@ jobs: stack-yaml: stack-extra-deps.yaml - resolver: lts-16 ghc: 8.8.4 - - resolver: lts-17 + stack-yaml: stack-extra-deps.yaml + - resolver: lts-18 ghc: 8.10.4 # Latest stable for MacOS: ghc-8.8.4 - resolver: lts-16 os: macos-latest + stack-yaml: stack-extra-deps.yaml # Latest stable for Windows: ghc-8.6.4 - resolver: lts-14 os: windows-latest + stack-yaml: stack-extra-deps.yaml env: STACK_YAML: stack.yaml From 8354dd86608dd8447ed1349b9f6644443aebd342 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sat, 19 Jun 2021 13:38:21 +0300 Subject: [PATCH 23/65] Add HasCallStack to all partial functions --- .github/workflows/haskell.yml | 2 +- massiv-test/src/Test/Massiv/Utils.hs | 7 ++ .../Test/Massiv/Array/Ops/ConstructSpec.hs | 4 +- .../tests/Test/Massiv/Array/Ops/FoldSpec.hs | 4 +- .../Test/Massiv/Array/Ops/TransformSpec.hs | 18 +-- .../tests/Test/Massiv/Array/StencilSpec.hs | 5 +- .../tests/Test/Massiv/Core/IndexSpec.hs | 1 + massiv-test/tests/Test/Massiv/VectorSpec.hs | 6 +- massiv/CHANGELOG.md | 1 + massiv/src/Data/Massiv/Array/Delayed/Pull.hs | 2 +- .../Data/Massiv/Array/Manifest/Internal.hs | 4 +- massiv/src/Data/Massiv/Array/Manifest/List.hs | 2 +- .../src/Data/Massiv/Array/Manifest/Vector.hs | 4 +- massiv/src/Data/Massiv/Array/Mutable.hs | 77 +----------- massiv/src/Data/Massiv/Array/Ops/Construct.hs | 41 ++++--- massiv/src/Data/Massiv/Array/Ops/Fold.hs | 41 ++++--- massiv/src/Data/Massiv/Array/Ops/Map.hs | 22 ---- massiv/src/Data/Massiv/Array/Ops/Slice.hs | 56 ++++++--- massiv/src/Data/Massiv/Array/Ops/Transform.hs | 116 +++++++++++------- massiv/src/Data/Massiv/Core.hs | 1 - massiv/src/Data/Massiv/Core/Common.hs | 31 +++-- massiv/src/Data/Massiv/Core/Exception.hs | 40 +++--- massiv/src/Data/Massiv/Core/Index.hs | 42 +++---- massiv/src/Data/Massiv/Vector.hs | 46 +++---- massiv/tests/doctests.hs | 2 +- 25 files changed, 274 insertions(+), 301 deletions(-) diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index 711054cf..bad44243 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -18,7 +18,7 @@ jobs: fail-fast: false matrix: os: [ubuntu-latest] - resolver: [nightly, lts-17, lts-16, lts-14, lts-12] + resolver: [nightly, lts-18, lts-16, lts-14, lts-12] include: - resolver: lts-12 ghc: 8.4.4 diff --git a/massiv-test/src/Test/Massiv/Utils.hs b/massiv-test/src/Test/Massiv/Utils.hs index 55d682de..f5170527 100644 --- a/massiv-test/src/Test/Massiv/Utils.hs +++ b/massiv-test/src/Test/Massiv/Utils.hs @@ -1,6 +1,7 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE TypeApplications #-} module Test.Massiv.Utils ( showsType @@ -10,6 +11,7 @@ module Test.Massiv.Utils , assertSomeException , assertSomeExceptionIO , toStringException + , selectErrorCall , ExpectedException(..) , applyFun2Compat , expectProp @@ -35,6 +37,7 @@ import Test.Hspec as X import Test.Hspec.QuickCheck 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) #if !MIN_VERSION_base(4,11,0) import Data.Semigroup as X ((<>)) @@ -90,6 +93,10 @@ 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 + data ExpectedException = ExpectedException deriving (Show, Eq) instance Exception ExpectedException diff --git a/massiv-test/tests/Test/Massiv/Array/Ops/ConstructSpec.hs b/massiv-test/tests/Test/Massiv/Array/Ops/ConstructSpec.hs index cd9e7c46..2517b298 100644 --- a/massiv-test/tests/Test/Massiv/Array/Ops/ConstructSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/Ops/ConstructSpec.hs @@ -24,9 +24,7 @@ prop_rangeStepEqEnumFromStepN from (NonZero step) sz = prop_rangeStepExc :: Int -> Int -> Property prop_rangeStepExc from to = assertException - (\case - IndexZeroException _ -> True - _ -> False) + selectErrorCall (computeAs U (rangeStep' Seq from 0 to)) prop_toFromListIsList :: diff --git a/massiv-test/tests/Test/Massiv/Array/Ops/FoldSpec.hs b/massiv-test/tests/Test/Massiv/Array/Ops/FoldSpec.hs index 8e1f9d47..508240f8 100644 --- a/massiv-test/tests/Test/Massiv/Array/Ops/FoldSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/Ops/FoldSpec.hs @@ -73,5 +73,5 @@ spec = do 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 - it "maximum'" $ (pure $! maximum' (A.empty :: Array D Ix3 Int)) `shouldThrow` emptySelector @Ix3 - it "minimum'" $ (pure $! minimum' (A.empty :: Array D Ix4 Int)) `shouldThrow` emptySelector @Ix4 + it "maximum'" $ (pure $! maximum' (A.empty :: Array D Ix3 Int)) `shouldThrow` selectErrorCall + it "minimum'" $ (pure $! minimum' (A.empty :: Array D Ix4 Int)) `shouldThrow` selectErrorCall diff --git a/massiv-test/tests/Test/Massiv/Array/Ops/TransformSpec.hs b/massiv-test/tests/Test/Massiv/Array/Ops/TransformSpec.hs index 2e68123d..32b0cba4 100644 --- a/massiv-test/tests/Test/Massiv/Array/Ops/TransformSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/Ops/TransformSpec.hs @@ -57,7 +57,7 @@ prop_SplitExtract (DimIx dim) (ArrIx arr ix) (Positive n) = where i = getDim' ix dim k = getDim' (unSz (size arr)) dim n' = n `mod` (k - i) - (left, center, right) = either throw id (splitExtractM dim i (Sz n') arr) + (left, center, right) = throwEither (splitExtractM dim i (Sz n') arr) (splitLeft, splitRight) = splitAt' dim (i + n') arr prop_ConcatAppend :: @@ -119,19 +119,19 @@ prop_ExtractSizeMismatch (ArrTiny arr) (Positive n) = -- => ArrNE P ix Int -- -> Property -- prop_stackInnerSlices (ArrNE arr) = --- arr === either throw compute (stackInnerSlicesM (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 === either throw compute (stackInnerSlicesM (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 === either throw compute (stackInnerSlicesM (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 === either throw compute (stackInnerSlicesM (innerSlices arr)) .&&. + arr === compute (throwEither (stackInnerSlicesM (innerSlices arr))) .&&. arr === compute (stackSlices' 1 (innerSlices arr)) -- prop_stackOuterSlices :: @@ -145,19 +145,19 @@ prop_stackInnerSlicesIx4 (ArrNE arr) = -- => ArrNE P ix Int -- -> Property -- prop_stackOuterSlices (ArrNE arr) = --- arr === either throw compute (stackOuterSlicesM (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 === either throw compute (stackOuterSlicesM (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 === either throw compute (stackOuterSlicesM (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 === either throw compute (stackOuterSlicesM (outerSlices arr)) .&&. + arr === compute (throwEither (stackOuterSlicesM (outerSlices arr))) .&&. arr === compute (stackSlices' (dimensions (Proxy :: Proxy Ix4)) (outerSlices arr)) diff --git a/massiv-test/tests/Test/Massiv/Array/StencilSpec.hs b/massiv-test/tests/Test/Massiv/Array/StencilSpec.hs index 2d038db1..d254f8c9 100644 --- a/massiv-test/tests/Test/Massiv/Array/StencilSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/StencilSpec.hs @@ -58,16 +58,13 @@ prop_DangerousStencil :: -> SzIx ix -> Property prop_DangerousStencil _ (DimIx r) (SzIx sz center) = - assertException validateException arr + assertException 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)) - validateException = \case - IndexOutOfBoundsException _ _ -> pure () - exc -> expectationFailure $ "Unexpected exception: " <> show exc instance Index ix => Show (Stencil ix a b) where diff --git a/massiv-test/tests/Test/Massiv/Core/IndexSpec.hs b/massiv-test/tests/Test/Massiv/Core/IndexSpec.hs index d26fa198..0bd5e8a3 100644 --- a/massiv-test/tests/Test/Massiv/Core/IndexSpec.hs +++ b/massiv-test/tests/Test/Massiv/Core/IndexSpec.hs @@ -7,6 +7,7 @@ {-# LANGUAGE TypeOperators #-} module Test.Massiv.Core.IndexSpec (spec) where +import Control.Exception import Control.DeepSeq import Data.Massiv.Array import Data.Massiv.Array.Unsafe (Sz(SafeSz)) diff --git a/massiv-test/tests/Test/Massiv/VectorSpec.hs b/massiv-test/tests/Test/Massiv/VectorSpec.hs index a4d68ee0..d4782b8a 100644 --- a/massiv-test/tests/Test/Massiv/VectorSpec.hs +++ b/massiv-test/tests/Test/Massiv/VectorSpec.hs @@ -9,7 +9,6 @@ module Test.Massiv.VectorSpec (spec) where import Control.Arrow (first) import Control.Applicative -import Control.DeepSeq import Control.Exception import Data.Bits import Data.Int @@ -31,9 +30,6 @@ import System.Random.MWC as MWC infix 4 !==!, !!==!! -sizeException :: SizeException -> Bool -sizeException exc = exc `deepseq` True - toUnboxV2 :: Unbox e => (VU.Vector e1 -> VU.Vector e2 -> VU.Vector e) @@ -142,7 +138,7 @@ toPrimV6 f v1 = toPrimV5 (f (toPrimitiveVector v1)) case eRes of Right vec' -> toPrimitiveVector (compute arr) `shouldBe` vec' Left (_exc :: ErrorCall) -> - shouldThrow (pure $! computeAs P arr) sizeException + shouldThrow (pure $! computeAs P arr) selectErrorCall newtype SeedVector = SeedVector (VP.Vector Word32) deriving (Eq, Show) diff --git a/massiv/CHANGELOG.md b/massiv/CHANGELOG.md index 426dd8fd..cbc79d59 100644 --- a/massiv/CHANGELOG.md +++ b/massiv/CHANGELOG.md @@ -15,6 +15,7 @@ * Remove `ix` from `Manifest` * Remove `ix` from `Source` * Remove `ix` from `Resize` +* Remove `liftArray2`. * Prevent `showsArrayPrec` from changing index type * Change function argument to monadic action for `unstablePartitionM` and `unsafeUnstablePartitionM` * Replace `snull` with a more generic `isNull` diff --git a/massiv/src/Data/Massiv/Array/Delayed/Pull.hs b/massiv/src/Data/Massiv/Array/Delayed/Pull.hs index 9210e6cf..f70ddb05 100644 --- a/massiv/src/Data/Massiv/Array/Delayed/Pull.hs +++ b/massiv/src/Data/Massiv/Array/Delayed/Pull.hs @@ -288,7 +288,7 @@ liftArray2Matching f !arr1 !arr2 (getComp arr1 <> getComp arr2) sz1 (\ !ix -> f (unsafeIndex arr1 ix) (unsafeIndex arr2 ix)) - | otherwise = throw $ SizeMismatchException (size arr1) (size arr2) + | otherwise = throwEither $ Left $ toException $ SizeMismatchException (size arr1) (size arr2) where sz1 = size arr1 sz2 = size arr2 diff --git a/massiv/src/Data/Massiv/Array/Manifest/Internal.hs b/massiv/src/Data/Massiv/Array/Manifest/Internal.hs index 3dd3adee..b7b109cb 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Internal.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Internal.hs @@ -235,10 +235,10 @@ fromRaggedArrayM arr = -- -- @since 0.1.1 fromRaggedArray' :: - forall r ix e r'. (Mutable r e, Ragged r' ix e) + forall r ix e r'. (HasCallStack, Mutable r e, Ragged r' ix e) => Array r' ix e -> Array r ix e -fromRaggedArray' arr = either throw id $ fromRaggedArrayM arr +fromRaggedArray' = throwEither . fromRaggedArrayM {-# INLINE fromRaggedArray' #-} diff --git a/massiv/src/Data/Massiv/Array/Manifest/List.hs b/massiv/src/Data/Massiv/Array/Manifest/List.hs index 12d319ac..eeda1537 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/List.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/List.hs @@ -121,7 +121,7 @@ fromListsM comp = fromRaggedArrayM . setComp comp . throughNested -- Array U *** Exception: DimTooLongException -- -- @since 0.1.0 -fromLists' :: forall r ix e . (Nested LN ix e, Ragged L ix e, Mutable r e) +fromLists' :: forall r ix e . (HasCallStack, Nested LN ix e, Ragged L ix e, Mutable r e) => Comp -- ^ Computation startegy to use -> [ListItem ix e] -- ^ Nested list -> Array r ix e diff --git a/massiv/src/Data/Massiv/Array/Manifest/Vector.hs b/massiv/src/Data/Massiv/Array/Manifest/Vector.hs index f93b114f..7edb4d69 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Vector.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Vector.hs @@ -108,12 +108,12 @@ fromVectorM comp sz v = -- -- @since 0.3.0 fromVector' :: - (Typeable v, VG.Vector v a, Load (ARepr v) ix a, Load r ix a, Mutable r a) + (HasCallStack, Typeable v, VG.Vector v a, Load (ARepr v) ix a, Load r ix a, Mutable r a) => Comp -> Sz ix -- ^ Resulting size of the array -> v a -- ^ Source Vector -> Array r ix a -fromVector' comp sz = either throw id . fromVectorM comp sz +fromVector' comp sz = throwEither . fromVectorM comp sz {-# INLINE fromVector' #-} -- | /O(1)/ - conversion from `Mutable` array to a corresponding vector. Will diff --git a/massiv/src/Data/Massiv/Array/Mutable.hs b/massiv/src/Data/Massiv/Array/Mutable.hs index d4537051..12595485 100644 --- a/massiv/src/Data/Massiv/Array/Mutable.hs +++ b/massiv/src/Data/Massiv/Array/Mutable.hs @@ -18,21 +18,17 @@ module Data.Massiv.Array.Mutable -- ** Element-wise mutation , read , readM - , read' , write , write_ , writeM - , write' , modify , modify_ , modifyM , modifyM_ - , modify' , swap , swap_ , swapM , swapM_ - , swap' -- ** Operations on @MArray@ -- *** Immutable conversion , thaw @@ -40,7 +36,6 @@ module Data.Massiv.Array.Mutable , freeze , freezeS -- *** Create mutable - , new , newMArray , newMArray' , makeMArray @@ -112,20 +107,6 @@ import Data.Massiv.Core.Common import Data.Massiv.Array.Mutable.Internal import Prelude hiding (mapM, read) --- | /O(n)/ - Initialize a new mutable array. All elements will be set to some default value. For --- boxed arrays in will be a thunk with `Uninitialized` exception, while for others it will be --- simply zeros. --- --- @since 0.1.0 -new :: - forall r ix e m. (Mutable r e, Index ix, PrimMonad m) - => Sz ix - -> m (MArray (PrimState m) r ix e) -new = initializeNew Nothing -{-# INLINE new #-} -{-# DEPRECATED new "In favor of a more robust and safer `newMArray` or a more consistently named `newMArray'`" #-} - - -- | /O(n)/ - Initialize a new mutable array. All elements will be set to some default value. For -- boxed arrays it will be a thunk with `Uninitialized` exception, while for others it will be -- simply zeros. @@ -148,7 +129,7 @@ new = initializeNew Nothing -- [ [ 0, 0, 0, 0, 0, 0 ] -- , [ 0, 0, 0, 0, 0, 0 ] -- ] --- >>> newMArray' @B @_ @Int (Sz2 2 6) >>= (`readM` 1) +-- >>> newMArray' @B @_ @Int (Sz2 2 6) >>= freezeS -- *** Exception: Uninitialized -- -- @since 0.6.0 @@ -402,7 +383,7 @@ createArray_ :: -- ^ An action that should fill all elements of the brand new mutable array -> m (Array r ix e) createArray_ comp sz action = do - marr <- new sz + marr <- newMArray' sz withScheduler_ comp (`action` marr) unsafeFreeze comp marr {-# INLINE createArray_ #-} @@ -420,7 +401,7 @@ createArray :: -- ^ An action that should fill all elements of the brand new mutable array -> m ([a], Array r ix e) createArray comp sz action = do - marr <- new sz + marr <- newMArray' sz a <- withScheduler comp (`action` marr) arr <- unsafeFreeze comp marr return (a, arr) @@ -458,7 +439,7 @@ createArrayS :: -- ^ An action that should fill all elements of the brand new mutable array -> m (a, Array r ix e) createArrayS sz action = do - marr <- new sz + marr <- newMArray' sz a <- action marr arr <- unsafeFreeze Seq marr return (a, arr) @@ -998,18 +979,6 @@ readM marr ix = {-# INLINE readM #-} --- | /O(1)/ - Same as `read`, but throws `IndexOutOfBoundsException` on an invalid index. --- --- @since 0.1.0 -read' :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> m e -read' marr ix = - read marr ix >>= \case - Just e -> pure e - Nothing -> throw $ IndexOutOfBoundsException (msize marr) ix -{-# INLINE read' #-} -{-# DEPRECATED read' "In favor of more general `readM`" #-} - - -- | /O(1)/ - Write an element into the cell of a mutable array. Returns `False` when index is out -- of bounds. -- @@ -1041,16 +1010,6 @@ writeM marr ix e = {-# INLINE writeM #-} --- | /O(1)/ - Same as `write`, but lives in IO and throws `IndexOutOfBoundsException` on invalid --- index. --- --- @since 0.1.0 -write' :: - (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> e -> m () -write' marr ix e = write marr ix e >>= (`unless` throw (IndexOutOfBoundsException (msize marr) ix)) -{-# INLINE write' #-} -{-# DEPRECATED write' "In favor of more general `writeM`" #-} - -- | /O(1)/ - Modify an element in the cell of a mutable array with a supplied -- action. Returns the previous value, if index was not out of bounds. -- @@ -1119,19 +1078,6 @@ modifyM_ marr f ix = void $ modifyM marr f ix {-# INLINE modifyM_ #-} --- | /O(1)/ - Same as `modify`, but throws an error if index is out of bounds. --- --- @since 0.1.0 -modify' :: (Mutable r e, Index ix, PrimMonad m) => - MArray (PrimState m) r ix e -> (e -> e) -> ix -> m () -modify' marr f ix = - modify marr (pure . f) ix >>= \case - Just _ -> pure () - Nothing -> throw (IndexOutOfBoundsException (msize marr) ix) -{-# INLINE modify' #-} -{-# DEPRECATED modify' "In favor of more general `modifyM`" #-} - - -- | /O(1)/ - Same as `swapM`, but instead of throwing an exception returns `Nothing` when -- either one of the indices is out of bounds and `Just` elements under those indices -- otherwise. @@ -1186,18 +1132,3 @@ swapM_ :: swapM_ marr ix1 ix2 = void $ swapM marr ix1 ix2 {-# INLINE swapM_ #-} - --- | /O(1)/ - Same as `swap`, but throws an `IndexOutOfBoundsException` on invalid indices. --- --- @since 0.1.0 -swap' :: - (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> ix -> m () -swap' marr ix1 ix2 = - swap marr ix1 ix2 >>= \case - Just _ -> pure () - Nothing -> - if isSafeIndex (msize marr) ix1 - then throw $ IndexOutOfBoundsException (msize marr) ix2 - else throw $ IndexOutOfBoundsException (msize marr) ix1 -{-# INLINE swap' #-} -{-# DEPRECATED swap' "In favor of more general `swapM`" #-} diff --git a/massiv/src/Data/Massiv/Array/Ops/Construct.hs b/massiv/src/Data/Massiv/Array/Ops/Construct.hs index b61f7520..cd50e186 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Construct.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Construct.hs @@ -511,12 +511,13 @@ range comp !from !to = rangeSize comp from (Sz (liftIndex2 (-) to from)) -- *** Exception: IndexZeroException: 0 -- -- @since 0.3.0 -rangeStepM :: (Index ix, MonadThrow m) => - Comp -- ^ Computation strategy - -> ix -- ^ Start - -> ix -- ^ Step (Can't have zeros) - -> ix -- ^ End - -> m (Array D ix ix) +rangeStepM :: + forall ix m. (Index ix, MonadThrow m) + => Comp -- ^ Computation strategy + -> ix -- ^ Start + -> ix -- ^ Step (Can't have zeros) + -> ix -- ^ End + -> m (Array D ix ix) rangeStepM comp !from !step !to | foldlIndex (\acc i -> acc || i == 0) False step = throwM $ IndexZeroException step | otherwise = @@ -536,8 +537,8 @@ rangeStepM comp !from !step !to -- [ 1, 3, 5 ] -- -- @since 0.3.0 -rangeStep' :: Index ix => Comp -> ix -> ix -> ix -> Array D ix ix -rangeStep' comp from step = either throw id . rangeStepM comp from step +rangeStep' :: (HasCallStack, Index ix) => Comp -> ix -> ix -> ix -> Array D ix ix +rangeStep' comp from step = throwEither . rangeStepM comp from step {-# INLINE rangeStep' #-} -- | Just like `range`, except the finish index is included. @@ -559,8 +560,8 @@ rangeStepInclusiveM comp ixFrom step ixTo = rangeStepM comp ixFrom step (liftInd -- | Just like `range`, except the finish index is included. -- -- @since 0.3.1 -rangeStepInclusive' :: Index ix => Comp -> ix -> ix -> ix -> Array D ix ix -rangeStepInclusive' comp ixFrom step = either throw id . rangeStepInclusiveM comp ixFrom step +rangeStepInclusive' :: (HasCallStack, Index ix) => Comp -> ix -> ix -> ix -> Array D ix ix +rangeStepInclusive' comp ixFrom step = throwEither . rangeStepInclusiveM comp ixFrom step {-# INLINE rangeStepInclusive' #-} @@ -699,7 +700,7 @@ enumFromStepN comp !from !step !sz = makeArrayLinear comp sz $ \ i -> from + fro -- -- @since 0.2.6 expandWithin :: - forall ix e r n a. (IsIndexDimension ix n, Index (Lower ix), Manifest r a) + forall n ix e r a. (IsIndexDimension ix n, Index (Lower ix), Manifest r a) => Dimension n -> Sz1 -> (a -> Ix1 -> e) @@ -718,22 +719,22 @@ expandWithin dim (Sz k) f arr = -- will throw an exception on an invalid dimension. -- -- @since 0.2.6 -expandWithin' - :: (Index ix, Index (Lower ix), Manifest r a) +expandWithin' :: + forall r ix a b. (HasCallStack, Index ix, Index (Lower ix), Manifest r a) => Dim -> Sz1 -> (a -> Ix1 -> b) -> Array r (Lower ix) a -> Array D ix b -expandWithin' dim k f arr = either throw id $ expandWithinM dim k f arr +expandWithin' dim k f = throwEither . expandWithinM dim k f {-# INLINE expandWithin' #-} -- | Similar to `expandWithin`, except that dimension is specified at a value level, which means it -- will throw an exception on an invalid dimension. -- -- @since 0.4.0 -expandWithinM - :: (Index ix, Index (Lower ix), Manifest r a, MonadThrow m) +expandWithinM :: + forall r ix a b m. (Index ix, Index (Lower ix), Manifest r a, MonadThrow m) => Dim -> Sz1 -> (a -> Ix1 -> b) @@ -750,8 +751,8 @@ expandWithinM dim k f arr = do -- | Similar to `expandWithin`, except it uses the outermost dimension. -- -- @since 0.2.6 -expandOuter - :: (Index ix, Index (Lower ix), Manifest r a) +expandOuter :: + forall r ix a b. (Index ix, Index (Lower ix), Manifest r a) => Sz1 -> (a -> Ix1 -> b) -> Array r (Lower ix) a @@ -768,8 +769,8 @@ expandOuter k f arr = -- | Similar to `expandWithin`, except it uses the innermost dimension. -- -- @since 0.2.6 -expandInner - :: (Index ix, Index (Lower ix), Manifest r a) +expandInner :: + forall r ix a b. (Index ix, Index (Lower ix), Manifest r a) => Sz1 -> (a -> Ix1 -> b) -> Array r (Lower ix) a diff --git a/massiv/src/Data/Massiv/Array/Ops/Fold.hs b/massiv/src/Data/Massiv/Array/Ops/Fold.hs index 8b906dcd..44638f5d 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Fold.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Fold.hs @@ -203,7 +203,7 @@ foldrWithin dim f = ifoldrWithin dim (const f) -- will throw an exception on an invalid dimension. -- -- @since 0.2.4 -ifoldlWithin' :: (Index (Lower ix), Index ix, Source r e) => +ifoldlWithin' :: (HasCallStack, Index (Lower ix), Index ix, Source r e) => Dim -> (ix -> a -> e -> a) -> a -> Array r ix e -> Array D (Lower ix) a ifoldlWithin' dim f acc0 arr = makeArray (getComp arr) (SafeSz szl) $ \ixl -> @@ -224,7 +224,7 @@ ifoldlWithin' dim f acc0 arr = -- throw an exception on an invalid dimension. -- -- @since 0.2.4 -foldlWithin' :: (Index (Lower ix), Index ix, Source r e) => +foldlWithin' :: (HasCallStack, Index (Lower ix), Index ix, Source r e) => Dim -> (a -> e -> a) -> a -> Array r ix e -> Array D (Lower ix) a foldlWithin' dim f = ifoldlWithin' dim (const f) {-# INLINE foldlWithin' #-} @@ -235,7 +235,7 @@ foldlWithin' dim f = ifoldlWithin' dim (const f) -- -- -- @since 0.2.4 -ifoldrWithin' :: (Index (Lower ix), Index ix, Source r e) => +ifoldrWithin' :: (HasCallStack, Index (Lower ix), Index ix, Source r e) => Dim -> (ix -> e -> a -> a) -> a -> Array r ix e -> Array D (Lower ix) a ifoldrWithin' dim f acc0 arr = makeArray (getComp arr) (SafeSz szl) $ \ixl -> @@ -255,7 +255,7 @@ ifoldrWithin' dim f acc0 arr = -- will throw an exception on an invalid dimension. -- -- @since 0.2.4 -foldrWithin' :: (Index (Lower ix), Index ix, Source r e) => +foldrWithin' :: (HasCallStack, Index (Lower ix), Index ix, Source r e) => Dim -> (e -> a -> a) -> a -> Array r ix e -> Array D (Lower ix) a foldrWithin' dim f = ifoldrWithin' dim (const f) {-# INLINE foldrWithin' #-} @@ -316,7 +316,7 @@ foldWithin dim = foldlWithin dim mappend mempty -- -- @since 0.4.3 foldWithin' :: - (Index ix, Source r a, Monoid a, Index (Lower ix)) + (HasCallStack, Index ix, Source r a, Monoid a, Index (Lower ix)) => Dim -> Array r ix a -> Array D (Lower ix) a @@ -408,39 +408,42 @@ ifoldInnerSlice f arr = foldMono g $ range (getComp arr) 0 (unSz k) -- | /O(n)/ - Compute maximum of all elements. -- -- @since 0.3.0 -maximumM :: (MonadThrow m, Load r ix e, Source r e, Ord e) => Array r ix e -> m e +maximumM :: (MonadThrow m, Shape r ix, Source r e, Ord e) => Array r ix e -> m e maximumM arr = - if isEmpty arr - then throwM (SizeEmptyException (size arr)) - else let !e0 = unsafeIndex arr zeroIndex - in pure $ foldlInternal max e0 max e0 arr + if isNull arr + then throwM (SizeEmptyException (size arr)) + else let !e0 = unsafeIndex arr zeroIndex + in pure $ foldlInternal max e0 max e0 arr {-# INLINE maximumM #-} -- | /O(n)/ - Compute maximum of all elements. -- -- @since 0.3.0 -maximum' :: (Load r ix e, Source r e, Ord e) => Array r ix e -> e -maximum' = either throw id . maximumM +maximum' :: + forall r ix e. (HasCallStack, Shape r ix, Source r e, Ord e) + => Array r ix e + -> e +maximum' = throwEither . maximumM {-# INLINE maximum' #-} -- | /O(n)/ - Compute minimum of all elements. -- -- @since 0.3.0 -minimumM :: (MonadThrow m, Load r ix e, Source r e, Ord e) => Array r ix e -> m e +minimumM :: (MonadThrow m, Shape r ix, Source r e, Ord e) => Array r ix e -> m e minimumM arr = - if isEmpty arr - then throwM (SizeEmptyException (size arr)) - else let !e0 = unsafeIndex arr zeroIndex - in pure $ foldlInternal min e0 min e0 arr + if isNull arr + then throwM (SizeEmptyException (size arr)) + else let !e0 = unsafeIndex arr zeroIndex + in pure $ foldlInternal min e0 min e0 arr {-# INLINE minimumM #-} -- | /O(n)/ - Compute minimum of all elements. -- -- @since 0.3.0 -minimum' :: (Load r ix e, Source r e, Ord e) => Array r ix e -> e -minimum' = either throw id . minimumM +minimum' :: forall r ix e. (HasCallStack, Shape r ix, Source r e, Ord e) => Array r ix e -> e +minimum' = throwEither . minimumM {-# INLINE minimum' #-} diff --git a/massiv/src/Data/Massiv/Array/Ops/Map.hs b/massiv/src/Data/Massiv/Array/Ops/Map.hs index 9c657491..17d66c96 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Map.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Map.hs @@ -62,7 +62,6 @@ module Data.Massiv.Array.Ops.Map , izipWith , izipWith3 , izipWith4 - , liftArray2 -- *** Applicative , zipWithA , izipWithA @@ -307,27 +306,6 @@ izipWith3A f arr1 arr2 arr3 = {-# INLINE izipWith3A #-} - --- | Similar to `Data.Massiv.Array.zipWith`, except dimensions of both arrays either have to be the --- same, or at least one of the two array must be a singleton array, in which case it will behave as --- a `Data.Massiv.Array.map`. --- --- @since 0.1.4 -liftArray2 - :: (Index ix, Source r1 a, Source r2 b) - => (a -> b -> e) -> Array r1 ix a -> Array r2 ix b -> Array D ix e -liftArray2 f !arr1 !arr2 - | sz1 == oneSz = map (f (unsafeIndex arr1 zeroIndex)) arr2 - | sz2 == oneSz = map (`f` unsafeIndex arr2 zeroIndex) arr1 - | sz1 == sz2 = - DArray (getComp arr1 <> getComp arr2) sz1 (\ !ix -> f (unsafeIndex arr1 ix) (unsafeIndex arr2 ix)) - | otherwise = throw $ SizeMismatchException (size arr1) (size arr2) - where - sz1 = size arr1 - sz2 = size arr2 -{-# INLINE liftArray2 #-} - - -------------------------------------------------------------------------------- -- traverse -------------------------------------------------------------------- -------------------------------------------------------------------------------- diff --git a/massiv/src/Data/Massiv/Array/Ops/Slice.hs b/massiv/src/Data/Massiv/Array/Ops/Slice.hs index 42ebe6a8..644eb21e 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Slice.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Slice.hs @@ -79,8 +79,12 @@ infixl 4 !>, !?>, ??>, , , -- -- -- @since 0.1.0 -(!>) :: (Index ix, Index (Lower ix), Source r e) => Array r ix e -> Int -> Array r (Lower ix) e -(!>) !arr !ix = either throw id (arr !?> ix) +(!>) :: + forall r ix e. (HasCallStack, Index ix, Index (Lower ix), Source r e) + => Array r ix e + -> Int + -> Array r (Lower ix) e +(!>) !arr !ix = throwEither (arr !?> ix) {-# INLINE (!>) #-} @@ -89,7 +93,7 @@ infixl 4 !>, !?>, ??>, , , -- -- @since 0.1.0 (!?>) :: - (MonadThrow m, Index ix, Index (Lower ix), Source r e) + forall r ix e m. (MonadThrow m, Index ix, Index (Lower ix), Source r e) => Array r ix e -> Int -> m (Array r (Lower ix) e) @@ -116,7 +120,7 @@ infixl 4 !>, !?>, ??>, , , -- -- @since 0.1.0 (??>) :: - (MonadThrow m, Index ix, Index (Lower ix), Source r e) + forall r ix e m. (MonadThrow m, Index ix, Index (Lower ix), Source r e) => m (Array r ix e) -> Int -> m (Array r (Lower ix) e) @@ -127,7 +131,11 @@ infixl 4 !>, !?>, ??>, , , -- | /O(1)/ - Safe slice from the inside -- -- @since 0.1.0 -( Array r ix e -> Int -> m (Array D (Lower ix) e) +( Array r ix e + -> Int + -> m (Array D (Lower ix) e) (, !?>, ??>, , , -- | /O(1)/ - Similarly to (`!>`) slice an array from an opposite direction. -- -- @since 0.1.0 -( Array r ix e -> Int -> Array D (Lower ix) e +( Array r ix e + -> Int + -> Array D (Lower ix) e (, !?>, ??>, , , -- | /O(1)/ - Safe slicing continuation from the inside -- -- @since 0.1.0 -( m (Array r ix e) -> Int -> m (Array D (Lower ix) e) +( m (Array r ix e) + -> Int + -> m (Array D (Lower ix) e) (>= (, !?>, ??>, , , -- -- @since 0.1.0 () :: - (MonadThrow m, Index ix, Index (Lower ix), Source r e) => Array r ix e -> (Dim, Int) -> m (Array D (Lower ix) e) + forall r ix e m. (MonadThrow m, Index ix, Index (Lower ix), Source r e) + => Array r ix e + -> (Dim, Int) + -> m (Array D (Lower ix) e) () !arr (dim, i) = do (m, szl) <- pullOutSzM (size arr) dim unless (isSafeIndex m i) $ throwM $ IndexOutOfBoundsException m i @@ -185,7 +204,11 @@ internalInnerSlice dim cutSz arr i = do -- index is out of bounds or dimensions is invalid. -- -- @since 0.1.0 -() :: (Index ix, Index (Lower ix), Source r e) => Array r ix e -> (Dim, Int) -> Array D (Lower ix) e +() :: + forall r ix e. (HasCallStack, Index ix, Index (Lower ix), Source r e) + => Array r ix e + -> (Dim, Int) + -> Array D (Lower ix) e () !arr !dix = throwEither (arr dix) {-# INLINE () #-} @@ -194,7 +217,7 @@ internalInnerSlice dim cutSz arr i = do -- -- @since 0.1.0 () :: - (MonadThrow m, Index ix, Index (Lower ix), Source r e) + forall r ix e m. (MonadThrow m, Index ix, Index (Lower ix), Source r e) => m (Array r ix e) -> (Dim, Int) -> m (Array D (Lower ix) e) @@ -216,7 +239,9 @@ internalInnerSlice dim cutSz arr i = do -- -- @since 0.5.4 outerSlices :: - (Index ix, Index (Lower ix), Source r e) => Array r ix e -> Array D Ix1 (Array r (Lower ix) e) + forall r ix e. (Index ix, Index (Lower ix), Source r e) + => Array r ix e + -> Array D Ix1 (Array r (Lower ix) e) outerSlices arr = makeArray (getComp arr) k (unsafeOuterSlice (setComp Seq arr) szL) where (k, szL) = unconsSz $ size arr @@ -235,7 +260,10 @@ outerSlices arr = makeArray (getComp arr) k (unsafeOuterSlice (setComp Seq arr) -- [ 0 :. 1, 1 :. 1, 2 :. 1 ] -- -- @since 0.5.4 -innerSlices :: (Index ix, Source r e) => Array r ix e -> Array D Ix1 (Array D (Lower ix) e) +innerSlices :: + forall r ix e. (Index ix, Source r e) + => Array r ix e + -> Array D Ix1 (Array D (Lower ix) e) innerSlices arr = makeArray (getComp arr) k (unsafeInnerSlice (setComp Seq arr) szL) where (szL, k) = unsnocSz $ size arr @@ -288,7 +316,7 @@ innerSlices arr = makeArray (getComp arr) k (unsafeInnerSlice (setComp Seq arr) -- -- @since 0.5.4 withinSlices :: - (IsIndexDimension ix n, Index (Lower ix), Source r e) + forall n r ix e. (IsIndexDimension ix n, Index (Lower ix), Source r e) => Dimension n -> Array r ix e -> Array D Ix1 (Array D (Lower ix) e) @@ -303,7 +331,7 @@ withinSlices dim = either throwImpossible id . withinSlicesM (fromDimension dim) -- -- @since 0.5.4 withinSlicesM :: - (MonadThrow m, Index ix, Index (Lower ix), Source r e) + forall r ix e m. (MonadThrow m, Index ix, Index (Lower ix), Source r e) => Dim -> Array r ix e -> m (Array D Ix1 (Array D (Lower ix) e)) diff --git a/massiv/src/Data/Massiv/Array/Ops/Transform.hs b/massiv/src/Data/Massiv/Array/Ops/Transform.hs index fbbf3b4f..7f733204 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Transform.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Transform.hs @@ -81,7 +81,7 @@ import Prelude as P hiding (concat, splitAt, traverse, mapM_, reverse, take, dro -- | Extract a sub-array from within a larger source array. Array that is being extracted must be -- fully encapsulated in a source array, otherwise `SizeSubregionException` will be thrown. extractM :: - (MonadThrow m, Index ix, Source r e) + forall r ix e m. (MonadThrow m, Index ix, Source r e) => ix -- ^ Starting index -> Sz ix -- ^ Size of the resulting array -> Array r ix e -- ^ Source array @@ -101,12 +101,12 @@ extractM !sIx !newSz !arr -- -- @since 0.1.0 extract' :: - (Index ix, Source r e) + forall r ix e. (HasCallStack, Index ix, Source r e) => ix -- ^ Starting index -> Sz ix -- ^ Size of the resulting array -> Array r ix e -- ^ Source array -> Array D ix e -extract' sIx newSz = either throw id . extractM sIx newSz +extract' sIx newSz = throwEither . extractM sIx newSz {-# INLINE extract' #-} @@ -115,7 +115,7 @@ extract' sIx newSz = either throw id . extractM sIx newSz -- -- @since 0.3.0 extractFromToM :: - (MonadThrow m, Index ix, Source r e) + forall r ix e m. (MonadThrow m, Index ix, Source r e) => ix -- ^ Starting index -> ix -- ^ Index up to which elements should be extracted. -> Array r ix e -- ^ Source array. @@ -127,7 +127,7 @@ extractFromToM sIx eIx = extractM sIx (Sz (liftIndex2 (-) eIx sIx)) -- -- @since 0.2.4 extractFromTo' :: - (Index ix, Source r e) + forall r ix e. (HasCallStack, Index ix, Source r e) => ix -- ^ Starting index -> ix -- ^ Index up to which elmenets should be extracted. -> Array r ix e -- ^ Source array. @@ -141,7 +141,7 @@ extractFromTo' sIx eIx = extract' sIx $ Sz (liftIndex2 (-) eIx sIx) -- -- @since 0.3.0 resizeM :: - (MonadThrow m, Index ix', Index ix, Resize r) + forall r ix ix' e m. (MonadThrow m, Index ix', Index ix, Resize r) => Sz ix' -> Array r ix e -> m (Array r ix' e) @@ -151,14 +151,18 @@ resizeM sz arr = guardNumberOfElements (size arr) sz >> pure (unsafeResize sz ar -- | Same as `resizeM`, but will throw an error if supplied dimensions are incorrect. -- -- @since 0.1.0 -resize' :: (Index ix', Index ix, Resize r) => Sz ix' -> Array r ix e -> Array r ix' e -resize' sz = either throw id . resizeM sz +resize' :: + forall r ix ix' e. (HasCallStack, Index ix', Index ix, Resize r) + => Sz ix' + -> Array r ix e + -> Array r ix' e +resize' sz = throwEither . resizeM sz {-# INLINE resize' #-} -- | /O(1)/ - Reduce a multi-dimensional array into a flat vector -- -- @since 0.3.1 -flatten :: (Index ix, Resize r) => Array r ix e -> Vector r e +flatten :: forall r ix e. (Index ix, Resize r) => Array r ix e -> Vector r e flatten arr = unsafeResize (SafeSz (totalElem (size arr))) arr {-# INLINE flatten #-} @@ -182,7 +186,7 @@ flatten arr = unsafeResize (SafeSz (totalElem (size arr))) arr -- ] -- -- @since 0.1.0 -transpose :: Source r e => Matrix r e -> Matrix D e +transpose :: forall r e. Source r e => Matrix r e -> Matrix D e transpose = transposeInner {-# INLINE [1] transpose #-} @@ -224,8 +228,10 @@ transpose = transposeInner -- ] -- -- @since 0.1.0 -transposeInner :: (Index (Lower ix), Index ix, Source r e) - => Array r ix e -> Array D ix e +transposeInner :: + forall r ix e. (Index (Lower ix), Index ix, Source r e) + => Array r ix e + -> Array D ix e transposeInner !arr = makeArray (getComp arr) newsz newVal where transInner !ix = @@ -275,8 +281,10 @@ transposeInner !arr = makeArray (getComp arr) newsz newVal -- -- -- @since 0.1.0 -transposeOuter :: (Index (Lower ix), Index ix, Source r e) - => Array r ix e -> Array D ix e +transposeOuter :: + forall r ix e. (Index (Lower ix), Index ix, Source r e) + => Array r ix e + -> Array D ix e transposeOuter !arr = makeArray (getComp arr) newsz newVal where transOuter !ix = @@ -320,7 +328,11 @@ transposeOuter !arr = makeArray (getComp arr) newsz newVal -- ] -- -- @since 0.4.1 -reverse :: (IsIndexDimension ix n, Index ix, Source r e) => Dimension n -> Array r ix e -> Array D ix e +reverse :: + forall n r ix e. (IsIndexDimension ix n, Index ix, Source r e) + => Dimension n + -> Array r ix e + -> Array D ix e reverse dim = reverse' (fromDimension dim) {-# INLINE reverse #-} @@ -328,7 +340,11 @@ reverse dim = reverse' (fromDimension dim) -- `IndexDimensionException` for an incorrect dimension. -- -- @since 0.4.1 -reverseM :: (MonadThrow m, Index ix, Source r e) => Dim -> Array r ix e -> m (Array D ix e) +reverseM :: + forall r ix e m. (MonadThrow m, Index ix, Source r e) + => Dim + -> Array r ix e + -> m (Array D ix e) reverseM dim arr = do let sz = size arr k <- getDimM (unSz sz) dim @@ -340,8 +356,12 @@ reverseM dim arr = do -- `IndexDimensionException` from pure code. -- -- @since 0.4.1 -reverse' :: (Index ix, Source r e) => Dim -> Array r ix e -> Array D ix e -reverse' dim = either throw id . reverseM dim +reverse' :: + forall r ix e. (HasCallStack, Index ix, Source r e) + => Dim + -> Array r ix e + -> Array D ix e +reverse' dim = throwEither . reverseM dim {-# INLINE reverse' #-} -- | Rearrange elements of an array into a new one by using a function that maps indices of the @@ -389,11 +409,12 @@ backpermuteM sz ixF !arr = generateArray (getComp arr) sz (evaluateM arr . ixF) -- * Throws a runtime `IndexOutOfBoundsException` from pure code. -- -- @since 0.3.0 -backpermute' :: (Source r e, Index ix, Index ix') => - Sz ix' -- ^ Size of the result array - -> (ix' -> ix) -- ^ A function that maps indices of the new array into the source one. - -> Array r ix e -- ^ Source array. - -> Array D ix' e +backpermute' :: + forall r ix ix' e. (HasCallStack, Source r e, Index ix, Index ix') + => Sz ix' -- ^ Size of the result array + -> (ix' -> ix) -- ^ A function that maps indices of the new array into the source one. + -> Array r ix e -- ^ Source array. + -> Array D ix' e backpermute' sz ixF !arr = makeArray (getComp arr) sz (evaluate' arr . ixF) {-# INLINE backpermute' #-} @@ -469,16 +490,24 @@ appendM n !arr1 !arr2 = do -- | Same as `appendM`, but will throw an exception in pure code on mismatched sizes. -- -- @since 0.3.0 -append' :: (Index ix, Source r1 e, Source r2 e) => - Dim -> Array r1 ix e -> Array r2 ix e -> Array DL ix e -append' dim arr1 arr2 = either throw id $ appendM dim arr1 arr2 +append' :: + forall r1 r2 ix e. (HasCallStack, Index ix, Source r1 e, Source r2 e) + => Dim + -> Array r1 ix e + -> Array r2 ix e + -> Array DL ix e +append' dim arr1 arr2 = throwEither $ appendM dim arr1 arr2 {-# INLINE append' #-} -- | Concat many arrays together along some dimension. -- -- @since 0.3.0 -concat' :: (Foldable f, Index ix, Source r e) => Dim -> f (Array r ix e) -> Array DL ix e -concat' n arrs = either throw id $ concatM n arrs +concat' :: + forall f r ix e. (HasCallStack, Foldable f, Index ix, Source r e) + => Dim + -> f (Array r ix e) + -> Array DL ix e +concat' n = throwEither . concatM n {-# INLINE concat' #-} -- | Concatenate many arrays together along some dimension. It is important that all sizes are @@ -704,7 +733,7 @@ stackInnerSlicesM = stackSlicesM 1 -- -- @since 0.3.0 splitAtM :: - (MonadThrow m, Index ix, Source r e) + forall r ix e m. (MonadThrow m, Index ix, Source r e) => Dim -- ^ Dimension along which to split -> Int -- ^ Index along the dimension to split at -> Array r ix e -- ^ Source array @@ -728,8 +757,12 @@ splitAtM dim i arr = do -- -- @since 0.1.0 splitAt' :: - (Index ix, Source r e) => Dim -> Int -> Array r ix e -> (Array D ix e, Array D ix e) -splitAt' dim i arr = either throw id $ splitAtM dim i arr + forall r ix e. (HasCallStack, Index ix, Source r e) + => Dim + -> Int + -> Array r ix e + -> (Array D ix e, Array D ix e) +splitAt' dim i = throwEither . splitAtM dim i {-# INLINE splitAt' #-} @@ -737,7 +770,7 @@ splitAt' dim i arr = either throw id $ splitAtM dim i arr -- -- @since 0.3.5 splitExtractM :: - (MonadThrow m, Index ix, Source r e) + forall r ix e m. (MonadThrow m, Index ix, Source r e) => Dim -- ^ Dimension along which to do the extraction -> Ix1 -- ^ Start index along the dimension that needs to be extracted -> Sz Ix1 -- ^ Size of the extracted array along the dimension that it will be extracted @@ -785,7 +818,7 @@ splitExtractM dim startIx1 (Sz extractSzIx1) arr = do -- -- @since 0.6.1 replaceSlice :: - (MonadThrow m, Source r e, Source r' e, Index ix, Index (Lower ix)) + forall r r' ix e m. (MonadThrow m, Source r e, Source r' e, Index ix, Index (Lower ix)) => Dim -> Ix1 -> Array r' (Lower ix) e @@ -826,11 +859,7 @@ replaceSlice dim i sl arr = do -- -- @since 0.6.1 replaceOuterSlice :: - ( MonadThrow m - , Index ix - , Source r e - , Load r (Lower ix) e - ) + forall r ix e m. (MonadThrow m, Index ix, Source r e, Load r (Lower ix) e) => Ix1 -> Array r (Lower ix) e -> Array r ix e @@ -864,7 +893,7 @@ replaceOuterSlice i sl arr = replaceSlice (dimensions (size arr)) i sl arr -- -- @since 0.3.5 deleteRegionM :: - (MonadThrow m, Index ix, Source r e) + forall r ix e m. (MonadThrow m, Index ix, Source r e) => Dim -- ^ Along which axis should the removal happen -> Ix1 -- ^ At which index to start dropping slices -> Sz Ix1 -- ^ Number of slices to drop @@ -896,7 +925,7 @@ deleteRegionM dim ix sz arr = do -- -- @since 0.3.5 deleteRowsM :: - (MonadThrow m, Index ix, Index (Lower ix), Source r e) + forall r ix e m. (MonadThrow m, Index ix, Index (Lower ix), Source r e) => Ix1 -> Sz Ix1 -> Array r ix e @@ -925,7 +954,7 @@ deleteRowsM = deleteRegionM 2 -- -- @since 0.3.5 deleteColumnsM :: - (MonadThrow m, Index ix, Source r e) + forall r ix e m. (MonadThrow m, Index ix, Source r e) => Ix1 -> Sz Ix1 -> Array r ix e @@ -1041,7 +1070,8 @@ transformM getSzM getM arr = do -- -- @since 0.3.0 transform' :: - (Source r' e', Index ix', Index ix) + forall ix e r' ix' e' a. + (HasCallStack, Source r' e', Index ix', Index ix) => (Sz ix' -> (Sz ix, a)) -> (a -> (ix' -> e') -> ix -> e) -> Array r' ix' e' @@ -1080,7 +1110,7 @@ transform2M getSzM getM arr1 arr2 = do -- -- @since 0.3.0 transform2' :: - (Source r1 e1, Source r2 e2, Index ix, Index ix1, Index ix2) + (HasCallStack, Source r1 e1, Source r2 e2, Index ix, Index ix1, Index ix2) => (Sz ix1 -> Sz ix2 -> (Sz ix, a)) -> (a -> (ix1 -> e1) -> (ix2 -> e2) -> ix -> e) -> Array r1 ix1 e1 diff --git a/massiv/src/Data/Massiv/Core.hs b/massiv/src/Data/Massiv/Core.hs index 61109564..cb3269c2 100644 --- a/massiv/src/Data/Massiv/Core.hs +++ b/massiv/src/Data/Massiv/Core.hs @@ -43,7 +43,6 @@ module Data.Massiv.Core , NumericFloat -- * Exceptions , MonadThrow(..) - , throw , IndexException(..) , SizeException(..) , ShapeException(..) diff --git a/massiv/src/Data/Massiv/Core/Common.hs b/massiv/src/Data/Massiv/Core/Common.hs index 15e84aac..2fdd9bd3 100644 --- a/massiv/src/Data/Massiv/Core/Common.hs +++ b/massiv/src/Data/Massiv/Core/Common.hs @@ -78,7 +78,6 @@ module Data.Massiv.Core.Common , Semigroup((<>)) -- * Exceptions , MonadThrow(..) - , throw , IndexException(..) , SizeException(..) , ShapeException(..) @@ -96,7 +95,6 @@ module Data.Massiv.Core.Common #if !MIN_VERSION_base(4,11,0) import Data.Semigroup #endif -import Control.Exception (throw) import Control.Monad.Catch (MonadThrow(..)) import Control.Monad.IO.Unlift (MonadIO(liftIO), MonadUnliftIO) import Control.Monad.Primitive @@ -781,12 +779,14 @@ infixl 4 !, !?, ?? -- ] -- >>> a ! 0 :. 2 -- 3 --- >>> a ! 0 :. 3 --- *** Exception: IndexOutOfBoundsException: (0 :. 3) is not safe for (Sz (2 :. 3)) -- -- @since 0.1.0 -(!) :: (Index ix, Manifest r e) => Array r ix e -> ix -> e -(!) = index' +(!) :: + forall r ix e. (HasCallStack, Manifest r e, Index ix) + => Array r ix e + -> ix + -> e +(!) arr = throwEither . evaluateM arr {-# INLINE (!) #-} @@ -812,7 +812,11 @@ infixl 4 !, !?, ?? -- Nothing -- -- @since 0.1.0 -(!?) :: (Index ix, Manifest r e, MonadThrow m) => Array r ix e -> ix -> m e +(!?) :: + forall r ix e m. (Index ix, Manifest r e, MonadThrow m) + => Array r ix e + -> ix + -> m e (!?) = indexM {-# INLINE (!?) #-} @@ -918,8 +922,8 @@ borderIndex border arr = handleBorderIndex border (size arr) (unsafeIndex arr) -- *** Exception: IndexOutOfBoundsException: 150 is not safe for (Sz1 101) -- -- @since 0.1.0 -index' :: (Index ix, Manifest r e) => Array r ix e -> ix -> e -index' = evaluate' +index' :: (HasCallStack, Index ix, Manifest r e) => Array r ix e -> ix -> e +index' arr = throwEither . evaluateM arr {-# INLINE index' #-} -- | This is just like `indexM` function, but it allows getting values from @@ -957,13 +961,8 @@ evaluateM arr ix = -- *** Exception: IndexOutOfBoundsException: (150 :. 150) is not safe for (Sz (90 :. 190)) -- -- @since 0.3.0 -evaluate' :: (Index ix, Source r e) => Array r ix e -> ix -> e -evaluate' arr ix = - handleBorderIndex - (Fill (throw (IndexOutOfBoundsException (size arr) ix))) - (size arr) - (unsafeIndex arr) - ix +evaluate' :: (HasCallStack, Index ix, Source r e) => Array r ix e -> ix -> e +evaluate' arr = throwEither . evaluateM arr {-# INLINE evaluate' #-} diff --git a/massiv/src/Data/Massiv/Core/Exception.hs b/massiv/src/Data/Massiv/Core/Exception.hs index 50e4c18a..d0466293 100644 --- a/massiv/src/Data/Massiv/Core/Exception.hs +++ b/massiv/src/Data/Massiv/Core/Exception.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ImplicitParams #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | -- Module : Data.Massiv.Core.Exception @@ -11,19 +12,21 @@ -- Portability : non-portable -- module Data.Massiv.Core.Exception - ( ImpossibleException(..) - , throwImpossible + ( throwImpossible , throwEither , Uninitialized(..) , guardNumberOfElements , Exception(..) , SomeException + , HasCallStack ) where import Control.Exception import Control.Monad import Control.Monad.Catch import Data.Massiv.Core.Index.Internal +import GHC.Stack +import GHC.Exception #if !MIN_VERSION_exceptions(0, 10, 3) import Control.Monad.ST (ST) @@ -34,29 +37,32 @@ instance MonadThrow (ST s) where throwM = unsafeIOToST . throwIO #endif +-- | Throw an impossible error. +-- +-- @since 0.5.6 +throwImpossible :: HasCallStack => Exception e => e -> a +throwImpossible exc = throw (errorCallWithCallStackException msg ?callStack) + where + msg = + " ImpossibleException (" ++ + displayException exc ++ + "): Either one of the unsafe functions was used or it is a bug in the library. " ++ + "In latter case please report this error." -newtype ImpossibleException = - ImpossibleException SomeException - deriving (Show) - -throwImpossible :: Exception e => e -> a -throwImpossible = throw . ImpossibleException . toException {-# NOINLINE throwImpossible #-} -throwEither :: Either SomeException a -> a +-- | Throw an error on `Left` or produce the result on `Right`. Exception type is lost, so +-- do not expect to be able to catch it as such. Stick to `IO` if you need exception control +-- flow. +-- +-- @since 0.5.6 +throwEither :: HasCallStack => Either SomeException a -> a throwEither = \case - Left exc -> throw exc + Left exc -> throw (errorCallWithCallStackException (displayException exc) ?callStack) Right res -> res {-# INLINE throwEither #-} -instance Exception ImpossibleException where - displayException (ImpossibleException exc) = - " ImpossibleException (" ++ - displayException exc ++ - "): Either one of the unsafe functions was used or it is a bug in the library. " ++ - "In latter case please report this error." - -- | An error that gets thrown when an unitialized element of a boxed array gets accessed. Can only -- happen when array was constructed with `unsafeNew`. data Uninitialized = Uninitialized deriving Show diff --git a/massiv/src/Data/Massiv/Core/Index.hs b/massiv/src/Data/Massiv/Core/Index.hs index 5252aaae..4e56cc1d 100644 --- a/massiv/src/Data/Massiv/Core/Index.hs +++ b/massiv/src/Data/Massiv/Core/Index.hs @@ -99,11 +99,10 @@ module Data.Massiv.Core.Index ) where import Control.DeepSeq -import Control.Exception (throw) import Control.Monad.Catch (MonadThrow(..)) import Data.Coerce import Data.Functor.Identity (runIdentity) -import Data.Massiv.Core.Exception (guardNumberOfElements) +import Data.Massiv.Core.Exception import Data.Massiv.Core.Index.Internal import Data.Massiv.Core.Index.Ix import Data.Massiv.Core.Index.Stride @@ -298,8 +297,8 @@ initDim :: Index ix => ix -> Lower ix initDim = fst . unsnocDim {-# INLINE [1] initDim #-} --- | Change the value of a specific dimension within the index. Throws `IndexException`. See --- `setDimM` for a safer version and `setDimension` for a type safe version. +-- | Change the value of a specific dimension within the index. See `setDimM` for a safer +-- version and `setDimension` for a type safe version. -- -- ==== __Examples__ -- @@ -307,11 +306,11 @@ initDim = fst . unsnocDim -- 2 :> 10 :> 4 :. 5 -- -- @since 0.2.4 -setDim' :: Index ix => ix -> Dim -> Int -> ix -setDim' ix dim = either throw id . setDimM ix dim +setDim' :: (HasCallStack, Index ix) => ix -> Dim -> Int -> ix +setDim' ix dim = throwEither . setDimM ix dim {-# INLINE [1] setDim' #-} --- | Change the value from a specific dimension within the index. Throws `IndexException`. See +-- | Change the value from a specific dimension within the index. See -- `getDimM` for a safer version and `getDimension` for a type safe version. -- -- ==== __Examples__ @@ -322,11 +321,11 @@ setDim' ix dim = either throw id . setDimM ix dim -- *** Exception: IndexDimensionException: (Dim 0) for (2 :> 3 :> 4 :. 5) -- -- @since 0.2.4 -getDim' :: Index ix => ix -> Dim -> Int -getDim' ix = either throw id . getDimM ix +getDim' :: (HasCallStack, Index ix) => ix -> Dim -> Int +getDim' ix = throwEither . getDimM ix {-# INLINE [1] getDim' #-} --- | Update the value of a specific dimension within the index. Throws `IndexException`. See +-- | Update the value of a specific dimension within the index. See -- `modifyDimM` for a safer version and `modifyDimension` for a type safe version. -- -- ==== __Examples__ @@ -335,8 +334,8 @@ getDim' ix = either throw id . getDimM ix -- (4,2 :> 3 :> 14 :. 5) -- -- @since 0.4.1 -modifyDim' :: Index ix => ix -> Dim -> (Int -> Int) -> (Int, ix) -modifyDim' ix dim = either throw id . modifyDimM ix dim +modifyDim' :: (HasCallStack, Index ix) => ix -> Dim -> (Int -> Int) -> (Int, ix) +modifyDim' ix dim = throwEither . modifyDimM ix dim {-# INLINE [1] modifyDim' #-} -- | Remove a dimension from the index. @@ -363,11 +362,11 @@ dropDimM ix = fmap snd . pullOutDimM ix -- *** Exception: IndexDimensionException: (Dim 6) for (2 :> 3 :> 4 :. 5) -- -- @since 0.2.4 -dropDim' :: Index ix => ix -> Dim -> Lower ix -dropDim' ix = either throw id . dropDimM ix +dropDim' :: (HasCallStack, Index ix) => ix -> Dim -> Lower ix +dropDim' ix = throwEither . dropDimM ix {-# INLINE [1] dropDim' #-} --- | Lower the dimension of the index by pulling the specified dimension. Throws `IndexException`. See +-- | Lower the dimension of the index by pulling the specified dimension. See -- `pullOutDimM` for a safer version and `pullOutDimension` for a type safe version. -- -- ==== __Examples__ @@ -376,13 +375,12 @@ dropDim' ix = either throw id . dropDimM ix -- (3,2 :> 4 :. 5) -- -- @since 0.2.4 -pullOutDim' :: Index ix => ix -> Dim -> (Int, Lower ix) -pullOutDim' ix = either throw id . pullOutDimM ix +pullOutDim' :: (HasCallStack, Index ix) => ix -> Dim -> (Int, Lower ix) +pullOutDim' ix = throwEither . pullOutDimM ix {-# INLINE [1] pullOutDim' #-} --- | Raise the dimension of the index by inserting one in the specified dimension. Throws --- `IndexException`. See `insertDimM` for a safer version and `insertDimension` for a type safe --- version. +-- | Raise the dimension of the index by inserting one in the specified dimension. See +-- `insertDimM` for a safer version and `insertDimension` for a type safe version. -- -- ==== __Examples__ -- @@ -392,8 +390,8 @@ pullOutDim' ix = either throw id . pullOutDimM ix -- *** Exception: IndexDimensionException: (Dim 11) for (2 :> 3 :> 4 :. 5) -- -- @since 0.2.4 -insertDim' :: Index ix => Lower ix -> Dim -> Int -> ix -insertDim' ix dim = either throw id . insertDimM ix dim +insertDim' :: (HasCallStack, Index ix) => Lower ix -> Dim -> Int -> ix +insertDim' ix dim = throwEither . insertDimM ix dim {-# INLINE [1] insertDim' #-} -- | Get the value level `Dim` from the type level equivalent. diff --git a/massiv/src/Data/Massiv/Vector.hs b/massiv/src/Data/Massiv/Vector.hs index 91542e89..911bca3d 100644 --- a/massiv/src/Data/Massiv/Vector.hs +++ b/massiv/src/Data/Massiv/Vector.hs @@ -375,8 +375,8 @@ slength v = -- cause materialization of the full vector if any other function is applied to the vector. -- -- @since 0.5.0 -head' :: Source r e => Vector r e -> e -head' = either throw id . headM +head' :: (HasCallStack, Source r e) => Vector r e -> e +head' = throwEither . headM {-# INLINE head' #-} @@ -423,8 +423,8 @@ headM v -- *** Exception: SizeEmptyException: (Sz1 0) corresponds to an empty array -- -- @since 0.5.0 -shead' :: Stream r Ix1 e => Vector r e -> e -shead' = either throw id . sheadM +shead' :: (HasCallStack, Stream r Ix1 e) => Vector r e -> e +shead' = throwEither . sheadM {-# INLINE shead' #-} -- | /O(1)/ - Get the first element of a `Stream` vector. @@ -524,8 +524,8 @@ unsnocM arr -- cause materialization of the full vector if any other function is applied to the vector. -- -- @since 0.5.0 -last' :: Source r e => Vector r e -> e -last' = either throw id . lastM +last' :: (HasCallStack, Source r e) => Vector r e -> e +last' = throwEither . lastM {-# INLINE last' #-} @@ -594,8 +594,8 @@ slice !i (Sz k) v = unsafeLinearSlice i' newSz v -- [ 9999999999998, 9999999999999, 10000000000000 ] -- -- @since 0.5.0 -slice' :: Source r e => Ix1 -> Sz1 -> Vector r e -> Vector r e -slice' i k = either throw id . sliceM i k +slice' :: (HasCallStack, Source r e) => Ix1 -> Sz1 -> Vector r e -> Vector r e +slice' i k = throwEither . sliceM i k {-# INLINE slice' #-} @@ -672,8 +672,8 @@ init v = unsafeLinearSlice 0 (Sz (coerce (size v) - 1)) v -- Array D *** Exception: SizeEmptyException: (Sz1 0) corresponds to an empty array -- -- @since 0.5.0 -init' :: Source r e => Vector r e -> Vector r e -init' = either throw id . initM +init' :: (HasCallStack, Source r e) => Vector r e -> Vector r e +init' = throwEither . initM {-# INLINE init' #-} -- | /O(1)/ - Get a vector without the last element. Throws an error on empty @@ -725,8 +725,8 @@ tail = drop 1 -- Array D *** Exception: SizeEmptyException: (Sz1 0) corresponds to an empty array -- -- @since 0.5.0 -tail' :: Source r e => Vector r e -> Vector r e -tail' = either throw id . tailM +tail' :: (HasCallStack, Source r e) => Vector r e -> Vector r e +tail' = throwEither . tailM {-# INLINE tail' #-} @@ -803,8 +803,8 @@ takeWhile f v = take (go 0) v -- Array D *** Exception: SizeSubregionException: (Sz1 10) is to small for 0 (Sz1 15) -- -- @since 0.5.0 -take' :: Source r e => Sz1 -> Vector r e -> Vector r e -take' k = either throw id . takeM k +take' :: (HasCallStack, Source r e) => Sz1 -> Vector r e -> Vector r e +take' k = throwEither . takeM k {-# INLINE take' #-} -- | /O(1)/ - Get the vector with the first @n@ elements. Throws an error size is less than @n@ @@ -874,8 +874,8 @@ sdrop n = fromSteps . S.drop n . S.toStream -- ==== __Examples__ -- -- @since 0.5.0 -drop' :: Source r e => Sz1 -> Vector r e -> Vector r e -drop' k = either throw id . dropM k +drop' :: (HasCallStack, Source r e) => Sz1 -> Vector r e -> Vector r e +drop' k = throwEither . dropM k {-# INLINE drop' #-} -- | @@ -909,8 +909,8 @@ sliceAt (Sz k) v = (unsafeTake d v, unsafeDrop d v) -- ==== __Examples__ -- -- @since 0.5.0 -sliceAt' :: Source r e => Sz1 -> Vector r e -> (Vector r e, Vector r e) -sliceAt' k = either throw id . sliceAtM k +sliceAt' :: (HasCallStack, Source r e) => Sz1 -> Vector r e -> (Vector r e, Vector r e) +sliceAt' k = throwEither . sliceAtM k {-# INLINE sliceAt' #-} -- | Same as `Data.Massiv.Array.splitAtM`, except for a flat vector. @@ -2281,7 +2281,7 @@ sizipWith6M_ f v1 v2 v3 v4 v5 v6 = --- | +-- | Strict left fold sequentially over a streamed array. -- -- ==== __Examples__ -- @@ -2314,8 +2314,8 @@ sfoldlM_ f acc = void . sfoldlM f acc -- ==== __Examples__ -- -- @since 0.5.0 -sfoldl1' :: Stream r ix e => (e -> e -> e) -> Array r ix e -> e -sfoldl1' f = either throw id . sfoldl1M (\e -> pure . f e) +sfoldl1' :: (HasCallStack, Stream r ix e) => (e -> e -> e) -> Array r ix e -> e +sfoldl1' f = throwEither . sfoldl1M (\e -> pure . f e) {-# INLINE sfoldl1' #-} -- | @@ -2455,7 +2455,7 @@ sproduct = sfoldl (*) 1 -- *** Exception: SizeEmptyException: (Sz1 0) corresponds to an empty array -- -- @since 0.5.0 -smaximum' :: (Ord e, Stream r ix e) => Array r ix e -> e +smaximum' :: (HasCallStack, Ord e, Stream r ix e) => Array r ix e -> e smaximum' = sfoldl1' max {-# INLINE smaximum' #-} @@ -2492,7 +2492,7 @@ smaximumM = sfoldl1M (\e acc -> pure (max e acc)) -- *** Exception: SizeEmptyException: (Sz (0 :. 0)) corresponds to an empty array -- -- @since 0.5.0 -sminimum' :: (Ord e, Stream r ix e) => Array r ix e -> e +sminimum' :: (HasCallStack, Ord e, Stream r ix e) => Array r ix e -> e sminimum' = sfoldl1' min {-# INLINE sminimum' #-} diff --git a/massiv/tests/doctests.hs b/massiv/tests/doctests.hs index cdd23174..2bf41e5a 100644 --- a/massiv/tests/doctests.hs +++ b/massiv/tests/doctests.hs @@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} module Main where -#if __GLASGOW_HASKELL__ >= 802 && __GLASGOW_HASKELL__ < 810 +#if __GLASGOW_HASKELL__ >= 802 import Test.DocTest (doctest) From 17a9310b01bb19d541f2a570b91f79de87aff8c0 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sat, 19 Jun 2021 15:12:18 +0300 Subject: [PATCH 24/65] Update hspec --- massiv-test/massiv-test.cabal | 2 ++ massiv-test/tests/Main.hs | 5 +++-- massiv-test/tests/Spec.hs | 2 +- stack-extra-deps.yaml | 7 ++++++- 4 files changed, 12 insertions(+), 4 deletions(-) diff --git a/massiv-test/massiv-test.cabal b/massiv-test/massiv-test.cabal index b83a02ec..9194abda 100644 --- a/massiv-test/massiv-test.cabal +++ b/massiv-test/massiv-test.cabal @@ -74,6 +74,7 @@ test-suite tests , Test.Massiv.Core.IndexSpec , Test.Massiv.Core.ListSpec , Test.Massiv.Core.SchedulerSpec + build-tool-depends: hspec-discover:hspec-discover build-depends: base , bytestring , containers @@ -127,6 +128,7 @@ test-suite tests-O0 , Test.Massiv.Core.IndexSpec , Test.Massiv.Core.ListSpec , Test.Massiv.Core.SchedulerSpec + build-tool-depends: hspec-discover:hspec-discover build-depends: base , bytestring , containers diff --git a/massiv-test/tests/Main.hs b/massiv-test/tests/Main.hs index 3a57d2cf..ffa8d7ef 100644 --- a/massiv-test/tests/Main.hs +++ b/massiv-test/tests/Main.hs @@ -1,10 +1,11 @@ module Main where -import System.IO (BufferMode(LineBuffering), hSetBuffering, stdout) +import Spec (spec) +import System.IO (BufferMode (LineBuffering), hSetBuffering, hSetEncoding, stdout, utf8) import Test.Hspec -import Spec main :: IO () main = do hSetBuffering stdout LineBuffering + hSetEncoding stdout utf8 hspec spec diff --git a/massiv-test/tests/Spec.hs b/massiv-test/tests/Spec.hs index b4e92e75..5416ef6a 100644 --- a/massiv-test/tests/Spec.hs +++ b/massiv-test/tests/Spec.hs @@ -1 +1 @@ -{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --no-main #-} +{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-} diff --git a/stack-extra-deps.yaml b/stack-extra-deps.yaml index 89549c75..a4b70fad 100644 --- a/stack-extra-deps.yaml +++ b/stack-extra-deps.yaml @@ -11,5 +11,10 @@ extra-deps: - vector-0.12.3.0@sha256:0ae2c1ba86f0077910be242ec6802cc3d7725fe7b2bea6987201aa3737b239b5,7953 - random-1.2.0@sha256:5ca8674e95c46c7eb90f520c26aea22d403625c97697275434afba66ebd32b05,5897 - mwc-random-0.15.0.1@sha256:48e4b01a7447671b8bd13957de65f19ef41ee0376083c0c501e179e68768276a,3372 -- QuickCheck-2.14.2@sha256:4ce29211223d5e6620ebceba34a3ca9ccf1c10c0cf387d48aea45599222ee5aa,7736 - splitmix-0.1.0.3@sha256:fc3aae74c467f4b608050bef53aec17904a618731df9407e655d8f3bf8c32d5c,6049 + +- QuickCheck-2.14.2@sha256:4ce29211223d5e6620ebceba34a3ca9ccf1c10c0cf387d48aea45599222ee5aa,7736 +- hspec-2.8.2@sha256:27523f8fb7b84729d7c8160c1db991fc2afac52b1bc4e99f0e239a1321031079,1709 +- hspec-core-2.8.2@sha256:251d8d96d06078ee41c4350c707fbdb9235cbcac3d89ea4a4075f1715d7c3a8f,4955 +- hspec-discover-2.8.2@sha256:e7d9f95303e3763114aa36b7f115bfa131ba490d8018c6468089b502dd208ec8,2183 +- hspec-expectations-0.8.2@sha256:e2db24881baadc2d9d23b03cb629e80dcbda89a6b04ace9adb5f4d02ef8b31aa,1594 From 8020357e1fd5012834502af3c5a4408dff14bcf3 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sat, 19 Jun 2021 17:26:56 +0300 Subject: [PATCH 25/65] Fix haddock and add a property for lists --- massiv-examples/stack.yaml | 5 ++- massiv/src/Data/Massiv/Array/Manifest/List.hs | 17 ++++----- massiv/src/Data/Massiv/Array/Ops/Construct.hs | 10 ++--- massiv/src/Data/Massiv/Core/Common.hs | 10 ++--- massiv/src/Data/Massiv/Core/Index.hs | 6 --- massiv/src/Data/Massiv/Vector.hs | 37 ++++++++----------- 6 files changed, 35 insertions(+), 50 deletions(-) diff --git a/massiv-examples/stack.yaml b/massiv-examples/stack.yaml index a4d74b82..31477c58 100644 --- a/massiv-examples/stack.yaml +++ b/massiv-examples/stack.yaml @@ -6,7 +6,10 @@ packages: - examples extra-deps: - ../massiv -- ../../massiv-io/massiv-io +- github: lehins/massiv-io + commit: d5cc91fd11383d8597489dcb00b28e93e5883787 + subdirs: + - massiv-io - Color-0.3.1@sha256:980a3869e25cbe91275113dd3273465e373b06d710c9e4ef3e0f07ec77815165,8193 #- massiv-io-0.4.1.0@sha256:fd1db3d851e0343833b8b3b6526be0f05782ee1f2152788616d71108d3b9676f,3667 - scheduler-1.5.0@sha256:8b43f2991bf9a720b12192ba99525f705a44aeae9541a7bd73fbc7e7b56fd8f0,2437 diff --git a/massiv/src/Data/Massiv/Array/Manifest/List.hs b/massiv/src/Data/Massiv/Array/Manifest/List.hs index eeda1537..b1d2bf2a 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/List.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/List.hs @@ -38,7 +38,7 @@ fromList :: forall r e. Mutable r e => Comp -- ^ Computation startegy to use -> [e] -- ^ Flat list - -> Array r Ix1 e + -> Vector r e fromList = fromLists' {-# INLINE fromList #-} @@ -88,13 +88,13 @@ fromListsM comp = fromRaggedArrayM . setComp comp . throughNested -- TODO: Figure out QuickCheck properties. Best guess idea so far IMHO is to add it as dependency -- and move Arbitrary instances int the library -- --- prop> fromLists' Seq xs == fromList xs --- --- | Same as `fromListsM`, but will throw a pure error on irregular shaped lists. +-- | Same as `fromListsM`, but will throw an error on irregular shaped lists. -- -- __Note__: This function is the same as if you would turn on @{-\# LANGUAGE OverloadedLists #-}@ -- extension. For that reason you can also use `GHC.Exts.fromList`. -- +-- prop> \xs -> fromLists' Seq xs == (fromList Seq xs :: Vector P Int) +-- -- ====__Examples__ -- -- Convert a list of lists into a 2D Array @@ -115,11 +115,6 @@ fromListsM comp = fromRaggedArrayM . setComp comp . throughNested -- , [ 4, 5, 6 ] -- ] -- --- Example of failure on conversion of an irregular nested list. --- --- >>> fromLists' Seq [[1],[3,4]] :: Array U Ix2 Int --- Array U *** Exception: DimTooLongException --- -- @since 0.1.0 fromLists' :: forall r ix e . (HasCallStack, Nested LN ix e, Ragged L ix e, Mutable r e) => Comp -- ^ Computation startegy to use @@ -219,3 +214,7 @@ toLists4 :: -> [[[[e]]]] toLists4 = toList . foldrInner (:) [] . foldrInner (:) [] . foldrInner (:) [] {-# INLINE toLists4 #-} + + +-- $setup +-- >>> import Data.Massiv.Array as A diff --git a/massiv/src/Data/Massiv/Array/Ops/Construct.hs b/massiv/src/Data/Massiv/Array/Ops/Construct.hs index cd50e186..c5de03f9 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Construct.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Construct.hs @@ -431,12 +431,12 @@ randomArrayS gen sz nextRandom = -- >>> :set -XTypeApplications -- >>> gens <- initWorkerStates (ParN 3) (MWC.initialize . A.toPrimitiveVector . A.singleton @P @Ix1 . fromIntegral . getWorkerId) -- >>> randomArrayWS gens (Sz2 2 3) (uniformRM (0, 9)) :: IO (Array P Ix2 Double) --- Array P Par (Sz (2 :. 3)) --- [ [ 2.5438514691269685, 4.287612444807011, 5.610339021582389 ] --- , [ 4.697970155404468, 5.00119167394813, 2.996037154611197 ] --- ] +-- Array P (ParN 3) (Sz (2 :. 3)) +-- [ [ 2.5438514691269685, 4.287612444807011, 5.610339021582389 ] +-- , [ 4.697970155404468, 5.00119167394813, 2.996037154611197 ] +-- ] -- >>> randomArrayWS gens (Sz1 10) (uniformRM (0, 9)) :: IO (Vector P Int) --- Array P Par (Sz1 10) +-- Array P (ParN 3) (Sz1 10) -- [ 0, 9, 3, 2, 2, 7, 6, 7, 7, 5 ] -- -- @since 0.3.4 diff --git a/massiv/src/Data/Massiv/Core/Common.hs b/massiv/src/Data/Massiv/Core/Common.hs index 2fdd9bd3..492a441f 100644 --- a/massiv/src/Data/Massiv/Core/Common.hs +++ b/massiv/src/Data/Massiv/Core/Common.hs @@ -908,8 +908,8 @@ borderIndex :: (Index ix, Manifest r e) => Border e -> Array r ix e -> ix -> e borderIndex border arr = handleBorderIndex border (size arr) (unsafeIndex arr) {-# INLINE borderIndex #-} --- | /O(1)/ - Lookup an element in the array. This is a partial function and it can throw --- `IndexOutOfBoundsException` inside pure code. It is safer to use `index` instead. +-- | /O(1)/ - Lookup an element in the array. This is a partial function and it will throw +-- an error when index is out of bounds. It is safer to use `indexM` instead. -- -- ==== __Examples__ -- @@ -918,8 +918,6 @@ borderIndex border arr = handleBorderIndex border (size arr) (unsafeIndex arr) -- >>> xs = [0..100] :: Array U Ix1 Int -- >>> index' xs 50 -- 50 --- >>> index' xs 150 --- *** Exception: IndexOutOfBoundsException: 150 is not safe for (Sz1 101) -- -- @since 0.1.0 index' :: (HasCallStack, Index ix, Manifest r e) => Array r ix e -> ix -> e @@ -950,15 +948,13 @@ evaluateM arr ix = ix {-# INLINE evaluateM #-} --- | Similar to `evaluateM`, but will throw an exception in pure code. +-- | Similar to `evaluateM`, but will throw an error on out of bounds indices. -- -- ==== __Examples__ -- -- >>> import Data.Massiv.Array -- >>> evaluate' (range Seq (Ix2 10 20) (100 :. 210)) 50 -- 60 :. 70 --- >>> evaluate' (range Seq (Ix2 10 20) (100 :. 210)) 150 --- *** Exception: IndexOutOfBoundsException: (150 :. 150) is not safe for (Sz (90 :. 190)) -- -- @since 0.3.0 evaluate' :: (HasCallStack, Index ix, Source r e) => Array r ix e -> ix -> e diff --git a/massiv/src/Data/Massiv/Core/Index.hs b/massiv/src/Data/Massiv/Core/Index.hs index 4e56cc1d..7a96895c 100644 --- a/massiv/src/Data/Massiv/Core/Index.hs +++ b/massiv/src/Data/Massiv/Core/Index.hs @@ -317,8 +317,6 @@ setDim' ix dim = throwEither . setDimM ix dim -- -- >>> getDim' (2 :> 3 :> 4 :. 5) 3 -- 3 --- >>> getDim' (2 :> 3 :> 4 :. 5) 0 --- *** Exception: IndexDimensionException: (Dim 0) for (2 :> 3 :> 4 :. 5) -- -- @since 0.2.4 getDim' :: (HasCallStack, Index ix) => ix -> Dim -> Int @@ -358,8 +356,6 @@ dropDimM ix = fmap snd . pullOutDimM ix -- -- >>> dropDim' (2 :> 3 :> 4 :. 5) 3 -- 2 :> 4 :. 5 --- >>> dropDim' (2 :> 3 :> 4 :. 5) 6 --- *** Exception: IndexDimensionException: (Dim 6) for (2 :> 3 :> 4 :. 5) -- -- @since 0.2.4 dropDim' :: (HasCallStack, Index ix) => ix -> Dim -> Lower ix @@ -386,8 +382,6 @@ pullOutDim' ix = throwEither . pullOutDimM ix -- -- >>> insertDim' (2 :> 3 :> 4 :. 5) 3 10 :: Ix5 -- 2 :> 3 :> 10 :> 4 :. 5 --- >>> insertDim' (2 :> 3 :> 4 :. 5) 11 10 :: Ix5 --- *** Exception: IndexDimensionException: (Dim 11) for (2 :> 3 :> 4 :. 5) -- -- @since 0.2.4 insertDim' :: (HasCallStack, Index ix) => Lower ix -> Dim -> Int -> ix diff --git a/massiv/src/Data/Massiv/Vector.hs b/massiv/src/Data/Massiv/Vector.hs index 911bca3d..198331fd 100644 --- a/massiv/src/Data/Massiv/Vector.hs +++ b/massiv/src/Data/Massiv/Vector.hs @@ -363,8 +363,6 @@ slength v = -- -- >>> head' (Ix1 10 ..: 10000000000000) -- 10 --- >>> head' (Ix1 10 ..: 10) --- *** Exception: SizeEmptyException: (Sz1 0) corresponds to an empty array -- -- /__Similar__/: -- @@ -418,9 +416,8 @@ headM v -- -- >>> shead' $ sunfoldr (\x -> Just (x, x)) (0 :: Int) -- 0 --- >>> x = shead' $ sunfoldr (\_ -> Nothing) (0 :: Int) --- >>> print x --- *** Exception: SizeEmptyException: (Sz1 0) corresponds to an empty array +-- >>> shead' (Ix1 3 ... 5) +-- 3 -- -- @since 0.5.0 shead' :: (HasCallStack, Stream r Ix1 e) => Vector r e -> e @@ -512,12 +509,10 @@ unsnocM arr -- -- >>> last' (Ix1 10 ... 10000000000000) -- 10000000000000 --- >>> last' (fromList Seq [] :: Array P Ix1 Int) --- *** Exception: SizeEmptyException: (Sz1 0) corresponds to an empty array -- -- /__Similar__/: -- --- [@Data.List.`Data.List.last`@] Also partial, but it has /O(n)/ complixity. Fusion is +-- [@Data.List.`Data.List.last`@] Also partial, but it has /O(n)/ complexity. Fusion is -- broken if there other consumers of the list. -- -- [@Data.Vector.Generic.`Data.Vector.Generic.last`@] Also constant time and partial. Will @@ -583,12 +578,6 @@ slice !i (Sz k) v = unsafeLinearSlice i' newSz v -- >>> slice' 10 5 (Ix1 0 ... 100) -- Array D Seq (Sz1 5) -- [ 10, 11, 12, 13, 14 ] --- >>> slice' (-10) 5 (Ix1 0 ... 100) --- Array D *** Exception: SizeSubregionException: (Sz1 101) is to small for -10 (Sz1 5) --- >>> slice' 98 50 (Ix1 0 ... 100) --- Array D *** Exception: SizeSubregionException: (Sz1 101) is to small for 98 (Sz1 50) --- >>> slice' 9999999999998 50 (Ix1 0 ... 10000000000000) --- Array D *** Exception: SizeSubregionException: (Sz1 10000000000001) is to small for 9999999999998 (Sz1 50) -- >>> slice' 9999999999998 3 (Ix1 0 ... 10000000000000) -- Array D Seq (Sz1 3) -- [ 9999999999998, 9999999999999, 10000000000000 ] @@ -605,6 +594,16 @@ slice' i k = throwEither . sliceM i k -- -- ==== __Examples__ -- +-- >>> sliceM 10 5 (Ix1 0 ... 100) +-- Array D Seq (Sz1 5) +-- [ 10, 11, 12, 13, 14 ] +-- >>> sliceM (-10) 5 (Ix1 0 ... 100) +-- *** Exception: SizeSubregionException: (Sz1 101) is to small for -10 (Sz1 5) +-- >>> sliceM 98 50 (Ix1 0 ... 100) +-- *** Exception: SizeSubregionException: (Sz1 101) is to small for 98 (Sz1 50) +-- >>> sliceM 9999999999998 3 (Ix1 0 ... 10000000000000) +-- Array D Seq (Sz1 3) +-- [ 9999999999998, 9999999999999, 10000000000000 ] -- -- @since 0.5.0 sliceM :: (Source r e, MonadThrow m) => Ix1 -> Sz1 -> Vector r e -> m (Vector r e) @@ -668,8 +667,6 @@ init v = unsafeLinearSlice 0 (Sz (coerce (size v) - 1)) v -- >>> init' (0 ..: 10) -- Array D Seq (Sz1 9) -- [ 0, 1, 2, 3, 4, 5, 6, 7, 8 ] --- >>> init' (empty :: Array D Ix1 Int) --- Array D *** Exception: SizeEmptyException: (Sz1 0) corresponds to an empty array -- -- @since 0.5.0 init' :: (HasCallStack, Source r e) => Vector r e -> Vector r e @@ -799,8 +796,6 @@ takeWhile f v = take (go 0) v -- >>> take' 5 (0 ..: 10) -- Array D Seq (Sz1 5) -- [ 0, 1, 2, 3, 4 ] --- >>> take' 15 (0 ..: 10) --- Array D *** Exception: SizeSubregionException: (Sz1 10) is to small for 0 (Sz1 15) -- -- @since 0.5.0 take' :: (HasCallStack, Source r e) => Sz1 -> Vector r e -> Vector r e @@ -818,6 +813,8 @@ take' k = throwEither . takeM k -- 10 -- >>> maybe (-1) sum $ takeM 15 (0 ..: 10) -- -1 +-- >>> takeM 15 (0 ..: 10) +-- *** Exception: SizeSubregionException: (Sz1 10) is to small for 0 (Sz1 15) -- -- @since 0.5.0 takeM :: (Source r e, MonadThrow m) => Sz1 -> Vector r e -> m (Vector r e) @@ -2451,8 +2448,6 @@ sproduct = sfoldl (*) 1 -- >>> import Data.Massiv.Vector as V -- >>> V.smaximum' $ V.sfromList [10, 3, 70, 5 :: Int] -- 70 --- >>> V.smaximum' (V.empty :: Vector D Int) --- *** Exception: SizeEmptyException: (Sz1 0) corresponds to an empty array -- -- @since 0.5.0 smaximum' :: (HasCallStack, Ord e, Stream r ix e) => Array r ix e -> e @@ -2488,8 +2483,6 @@ smaximumM = sfoldl1M (\e acc -> pure (max e acc)) -- >>> import Data.Massiv.Vector as V -- >>> V.sminimum' $ V.sfromList [10, 3, 70, 5 :: Int] -- 3 --- >>> V.sminimum' (V.empty :: Array D Ix2 Int) --- *** Exception: SizeEmptyException: (Sz (0 :. 0)) corresponds to an empty array -- -- @since 0.5.0 sminimum' :: (HasCallStack, Ord e, Stream r ix e) => Array r ix e -> e From db1407dce8d6879810d86a152597afe3998731eb Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sat, 19 Jun 2021 18:21:41 +0300 Subject: [PATCH 26/65] Fix doctests for ghc-9 --- .../src/Data/Massiv/Array/Manifest/Vector.hs | 1 + massiv/src/Data/Massiv/Vector.hs | 33 +++++++++++-------- 2 files changed, 20 insertions(+), 14 deletions(-) diff --git a/massiv/src/Data/Massiv/Array/Manifest/Vector.hs b/massiv/src/Data/Massiv/Array/Manifest/Vector.hs index 7edb4d69..2f9d4db6 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Vector.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Vector.hs @@ -156,6 +156,7 @@ castToVector arr = -- `VS.Vector` in costant time: -- -- >>> import Data.Massiv.Array as A +-- >>> import Data.Massiv.Array.Manifest.Vector (toVector) -- >>> import qualified Data.Vector.Storable as VS -- >>> toVector (makeArrayR S Par (Sz2 5 6) (\(i :. j) -> i + j)) :: VS.Vector Int -- [0,1,2,3,4,5,1,2,3,4,5,6,2,3,4,5,6,7,3,4,5,6,7,8,4,5,6,7,8,9] diff --git a/massiv/src/Data/Massiv/Vector.hs b/massiv/src/Data/Massiv/Vector.hs index 198331fd..27b768a9 100644 --- a/massiv/src/Data/Massiv/Vector.hs +++ b/massiv/src/Data/Massiv/Vector.hs @@ -648,10 +648,11 @@ sslice !i !k = fromSteps . S.slice i k . S.toStream -- -- ==== __Examples__ -- --- >>> init (0 ..: 10) +-- >>> import Data.Massiv.Array as A +-- >>> A.init (0 ..: 10) -- Array D Seq (Sz1 9) -- [ 0, 1, 2, 3, 4, 5, 6, 7, 8 ] --- >>> init (empty :: Array D Ix1 Int) +-- >>> A.init (empty :: Array D Ix1 Int) -- Array D Seq (Sz1 0) -- [ ] -- @@ -677,12 +678,13 @@ init' = throwEither . initM -- -- ==== __Examples__ -- +-- >>> import Data.Massiv.Array as A -- >>> initM (0 ..: 10) -- Array D Seq (Sz1 9) -- [ 0, 1, 2, 3, 4, 5, 6, 7, 8 ] --- >>> maybe 0 sum $ initM (0 ..: 10) +-- >>> maybe 0 A.sum $ initM (0 ..: 10) -- 36 --- >>> maybe 0 sum $ initM (empty :: Array D Ix1 Int) +-- >>> maybe 0 A.sum $ initM (empty :: Array D Ix1 Int) -- 0 -- -- @since 0.5.0 @@ -698,10 +700,11 @@ initM v = do -- -- ==== __Examples__ -- --- >>> tail (0 ..: 10) +-- >>> import Data.Massiv.Array as A +-- >>> A.tail (0 ..: 10) -- Array D Seq (Sz1 9) -- [ 1, 2, 3, 4, 5, 6, 7, 8, 9 ] --- >>> tail (empty :: Array D Ix1 Int) +-- >>> A.tail (empty :: Array D Ix1 Int) -- Array D Seq (Sz1 0) -- [ ] -- @@ -731,12 +734,13 @@ tail' = throwEither . tailM -- -- ==== __Examples__ -- +-- >>> import Data.Massiv.Array as A -- >>> tailM (0 ..: 10) -- Array D Seq (Sz1 9) -- [ 1, 2, 3, 4, 5, 6, 7, 8, 9 ] --- >>> maybe 0 sum $ tailM (0 ..: 10) +-- >>> maybe 0 A.sum $ tailM (0 ..: 10) -- 45 --- >>> maybe 0 sum $ tailM (empty :: Array D Ix1 Int) +-- >>> maybe 0 A.sum $ tailM (empty :: Array D Ix1 Int) -- 0 -- -- @since 0.5.0 @@ -752,16 +756,16 @@ tailM v = do -- -- ==== __Examples__ -- --- >>> take 5 (0 ..: 10) +-- >>> import Data.Massiv.Array as A +-- >>> A.take 5 (0 ..: 10) -- Array D Seq (Sz1 5) -- [ 0, 1, 2, 3, 4 ] --- >>> take (-5) (0 ..: 10) +-- >>> A.take (-5) (0 ..: 10) -- Array D Seq (Sz1 0) -- [ ] --- >>> take 100 (0 ..: 10) +-- >>> A.take 100 (0 ..: 10) -- Array D Seq (Sz1 10) -- [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9 ] --- >>> -- -- @since 0.5.0 take :: Source r e => Sz1 -> Vector r e -> Vector r e @@ -806,12 +810,13 @@ take' k = throwEither . takeM k -- -- ==== __Examples__ -- +-- >>> import Data.Massiv.Array as A -- >>> takeM 5 (0 ..: 10) -- Array D Seq (Sz1 5) -- [ 0, 1, 2, 3, 4 ] --- >>> maybe 0 sum $ takeM 5 (0 ..: 10) +-- >>> maybe 0 A.sum $ takeM 5 (0 ..: 10) -- 10 --- >>> maybe (-1) sum $ takeM 15 (0 ..: 10) +-- >>> maybe (-1) A.sum $ takeM 15 (0 ..: 10) -- -1 -- >>> takeM 15 (0 ..: 10) -- *** Exception: SizeSubregionException: (Sz1 10) is to small for 0 (Sz1 15) From 7301591c90fcc6d8578b376d88512fe60441aa0f Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sat, 19 Jun 2021 21:11:35 +0300 Subject: [PATCH 27/65] Fix compilation for ghc-8.0 --- massiv/src/Data/Massiv/Array/Delayed/Pull.hs | 21 +++++++++++-------- .../Data/Massiv/Array/Ops/Fold/Internal.hs | 2 +- .../src/Data/Massiv/Array/Stencil/Internal.hs | 3 +++ massiv/src/Data/Massiv/Core.hs | 2 ++ 4 files changed, 18 insertions(+), 10 deletions(-) diff --git a/massiv/src/Data/Massiv/Array/Delayed/Pull.hs b/massiv/src/Data/Massiv/Array/Delayed/Pull.hs index f70ddb05..80d9cb93 100644 --- a/massiv/src/Data/Massiv/Array/Delayed/Pull.hs +++ b/massiv/src/Data/Massiv/Array/Delayed/Pull.hs @@ -27,15 +27,15 @@ module Data.Massiv.Array.Delayed.Pull , unsafeInnerSlice ) where -import Control.Applicative +import Control.Applicative import qualified Data.Foldable as F -import Data.Massiv.Array.Ops.Fold.Internal as A -import Data.Massiv.Vector.Stream as S (steps) -import Data.Massiv.Core.Common -import Data.Massiv.Core.Operations -import Data.Massiv.Core.List (L, showArrayList, showsArrayPrec) -import GHC.Base (build) -import Prelude hiding (zipWith) +import Data.Massiv.Array.Ops.Fold.Internal as A +import Data.Massiv.Core.Common +import Data.Massiv.Core.List (L, showArrayList, showsArrayPrec) +import Data.Massiv.Core.Operations +import Data.Massiv.Vector.Stream as S (steps) +import GHC.Base (build) +import Prelude hiding (zipWith) #include "massiv.h" @@ -125,9 +125,12 @@ instance Functor (Array D ix) where instance Index ix => Applicative (Array D ix) where pure = singleton {-# INLINE pure #-} + (<*>) = liftArray2Matching id + {-# INLINE (<*>) #-} +#if MIN_VERSION_base(4,10,0) liftA2 = liftArray2Matching {-# INLINE liftA2 #-} - +#endif -- | Row-major sequential folding over a Delayed array. instance Index ix => Foldable (Array D ix) where diff --git a/massiv/src/Data/Massiv/Array/Ops/Fold/Internal.hs b/massiv/src/Data/Massiv/Array/Ops/Fold/Internal.hs index 34c024b9..4e54762a 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Fold/Internal.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Fold/Internal.hs @@ -415,7 +415,7 @@ anySliceSuM :: -> (e -> Bool) -> Array r ix e -> IO Bool -anySliceSuM batch ix0 (Sz k) f arr = go ix0 +anySliceSuM batch ix0 (Sz1 k) f arr = go ix0 where !k' = k - ix0 !k4 = ix0 + (k' - (k' `rem` 4)) diff --git a/massiv/src/Data/Massiv/Array/Stencil/Internal.hs b/massiv/src/Data/Massiv/Array/Stencil/Internal.hs index 051bf350..191959d0 100644 --- a/massiv/src/Data/Massiv/Array/Stencil/Internal.hs +++ b/massiv/src/Data/Massiv/Array/Stencil/Internal.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -102,6 +103,7 @@ instance Index ix => Applicative (Stencil ix e) where !maxCenter = unionStencilCenters s1 s2 {-# INLINE (<*>) #-} +#if MIN_VERSION_base(4,10,0) liftA2 f s1@(Stencil _ _ f1) s2@(Stencil _ _ f2) = Stencil newSz maxCenter stF where stF ug gV !ix = f (f1 ug gV ix) (f2 ug gV ix) @@ -109,6 +111,7 @@ instance Index ix => Applicative (Stencil ix e) where !newSz = unionStencilSizes maxCenter s1 s2 !maxCenter = unionStencilCenters s1 s2 {-# INLINE liftA2 #-} +#endif instance (Index ix, Num a) => Num (Stencil ix e a) where (+) = liftA2 (+) diff --git a/massiv/src/Data/Massiv/Core.hs b/massiv/src/Data/Massiv/Core.hs index cb3269c2..7b00d49e 100644 --- a/massiv/src/Data/Massiv/Core.hs +++ b/massiv/src/Data/Massiv/Core.hs @@ -35,6 +35,8 @@ module Data.Massiv.Core , appComp , WorkerStates , initWorkerStates + , scheduleWork + , scheduleWork_ , withMassivScheduler_ , module Data.Massiv.Core.Index -- * Numeric From 5cb2d6c522b8bee8d427e342ee6d0f8902c16f80 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sat, 19 Jun 2021 21:38:26 +0300 Subject: [PATCH 28/65] Handle warnings for ghc-9 --- massiv/src/Data/Massiv/Core/Common.hs | 9 +++++---- massiv/src/Data/Massiv/Core/Index/Internal.hs | 3 ++- massiv/src/Data/Massiv/Core/List.hs | 11 ++++++----- 3 files changed, 13 insertions(+), 10 deletions(-) diff --git a/massiv/src/Data/Massiv/Core/Common.hs b/massiv/src/Data/Massiv/Core/Common.hs index 492a441f..db2bda18 100644 --- a/massiv/src/Data/Massiv/Core/Common.hs +++ b/massiv/src/Data/Massiv/Core/Common.hs @@ -107,6 +107,7 @@ import Data.Massiv.Core.Exception import Data.Massiv.Core.Index import Data.Massiv.Core.Index.Internal (Sz(SafeSz)) import Data.Typeable +import Data.Kind import qualified Data.Vector.Fusion.Stream.Monadic as S (Stream) import Data.Vector.Fusion.Util @@ -117,7 +118,7 @@ import Data.Vector.Fusion.Util -- element, even if that element does not yet exist in memory and the arry has to be -- computed in order to get access to that element. Data is always arranged in a nested -- row-major fashion, depth of which is controlled by @`Rank` ix@. -data family Array r ix e :: * +data family Array r ix e :: Type -- | Type synonym for a single dimension array, or simply a flat vector. -- @@ -143,11 +144,11 @@ type MMatrix s r e = MArray s r Ix2 e -type family Elt r ix e :: * where +type family Elt r ix e :: Type where Elt r Ix1 e = e Elt r ix e = Array r (Lower ix) e -type family NestedStruct r ix e :: * +type family NestedStruct r ix e :: Type @@ -491,7 +492,7 @@ class (Resize r, Source r e) => Manifest r e where class (Manifest r e) => Mutable r e where - data MArray s r ix e :: * + data MArray s r ix e :: Type -- | Get the size of a mutable array. -- diff --git a/massiv/src/Data/Massiv/Core/Index/Internal.hs b/massiv/src/Data/Massiv/Core/Index/Internal.hs index ee44a3bc..4d7e721b 100644 --- a/massiv/src/Data/Massiv/Core/Index/Internal.hs +++ b/massiv/src/Data/Massiv/Core/Index/Internal.hs @@ -66,6 +66,7 @@ import Control.Exception (Exception(..), throw) import Control.Monad (when) import Control.Monad.Catch (MonadThrow(..)) import Data.Coerce +import Data.Kind import Data.Massiv.Core.Iterator import Data.Typeable import GHC.TypeLits @@ -366,7 +367,7 @@ type IsIndexDimension ix n = (1 <= n, n <= Dimensions ix, Index ix, KnownNat n) -- argument. -- -- @since 0.1.0 -type family Lower ix :: * +type family Lower ix :: Type type family ReportInvalidDim (dims :: Nat) (n :: Nat) isNotZero isLess :: Bool where diff --git a/massiv/src/Data/Massiv/Core/List.hs b/massiv/src/Data/Massiv/Core/List.hs index c5509d73..051db97e 100644 --- a/massiv/src/Data/Massiv/Core/List.hs +++ b/massiv/src/Data/Massiv/Core/List.hs @@ -33,11 +33,12 @@ import Control.Exception import Control.Monad (unless, when) import Control.Scheduler import Data.Coerce -import Data.Monoid import Data.Functor.Identity +import Data.Kind import qualified Data.List as L -import qualified Data.Massiv.Vector.Stream as S import Data.Massiv.Core.Common +import qualified Data.Massiv.Vector.Stream as S +import Data.Monoid import Data.Typeable import GHC.Exts import GHC.TypeLits @@ -45,7 +46,7 @@ import System.IO.Unsafe (unsafePerformIO) data LN -type family ListItem ix e :: * where +type family ListItem ix e :: Type where ListItem Ix1 e = e ListItem ix e = [ListItem (Lower ix) e] @@ -144,7 +145,7 @@ instance Shape LN Ix2 where {-# INLINE isNull #-} outerSize arr = case unList arr of - [] -> zeroSz + [] -> zeroSz (x:xs) -> SafeSz ((1 + length xs) :. length (unList x)) {-# INLINE outerSize #-} @@ -167,7 +168,7 @@ instance (Shape LN (Ix (n - 1)), Index (IxN n)) => Shape LN (IxN n) where {-# INLINE isNull #-} outerSize arr = case unList arr of - [] -> zeroSz + [] -> zeroSz (x:xs) -> SafeSz ((1 + length xs) :> unSz (outerSize x)) {-# INLINE outerSize #-} From 4e900f9a38a0279941e5499f8660309951b9b571 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sat, 19 Jun 2021 22:22:56 +0300 Subject: [PATCH 29/65] Disable doctests for ghc-8.10 --- massiv/tests/doctests.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/massiv/tests/doctests.hs b/massiv/tests/doctests.hs index 2bf41e5a..07bfc8ac 100644 --- a/massiv/tests/doctests.hs +++ b/massiv/tests/doctests.hs @@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} module Main where -#if __GLASGOW_HASKELL__ >= 802 +#if __GLASGOW_HASKELL__ >= 802 && __GLASGOW_HASKELL__ != 810 import Test.DocTest (doctest) @@ -12,6 +12,6 @@ main = doctest ["-Iinclude","src"] -- TODO: fix doctest support main :: IO () -main = putStrLn "\nDoctests are not supported for older ghc version\n" +main = putStrLn "\nDoctests are not supported for ghc version 8.2 and prior as well as 8.10\n" #endif From 6f80fead81d8112f9c192ac1aefca57471b77b34 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sun, 20 Jun 2021 02:22:00 +0300 Subject: [PATCH 30/65] Bunch of explicit foralls. Make negate partial in Num instance for Sz. Fix #114 --- .../tests/Test/Massiv/Core/IndexSpec.hs | 6 +- massiv-test/tests/Test/Massiv/VectorSpec.hs | 2 + massiv/CHANGELOG.md | 2 + massiv/src/Data/Massiv/Array/Delayed/Push.hs | 2 +- .../src/Data/Massiv/Array/Manifest/Vector.hs | 5 +- massiv/src/Data/Massiv/Array/Ops/Sort.hs | 2 +- massiv/src/Data/Massiv/Array/Stencil.hs | 21 - massiv/src/Data/Massiv/Core/Common.hs | 10 +- massiv/src/Data/Massiv/Core/Index/Internal.hs | 38 +- massiv/src/Data/Massiv/Vector.hs | 364 +++++++++++++----- massiv/src/Data/Massiv/Vector/Stream.hs | 10 +- massiv/src/Data/Massiv/Vector/Unsafe.hs | 2 +- shell.nix | 2 +- stack.yaml | 2 +- 14 files changed, 333 insertions(+), 135 deletions(-) diff --git a/massiv-test/tests/Test/Massiv/Core/IndexSpec.hs b/massiv-test/tests/Test/Massiv/Core/IndexSpec.hs index 0bd5e8a3..780759be 100644 --- a/massiv-test/tests/Test/Massiv/Core/IndexSpec.hs +++ b/massiv-test/tests/Test/Massiv/Core/IndexSpec.hs @@ -1,6 +1,7 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} @@ -141,7 +142,10 @@ specSz = do describe ("Sz (" ++ showsTypeRep (typeRep (Proxy :: Proxy ix)) ")") $ do szSpec @ix szNumSpec @ix - it "Show" $ property $ \sz -> ("Just (" ++ show (sz :: Sz ix) ++ ")") === show (Just sz) + prop "throws error on negate" $ \sz -> + sz /= zeroSz ==> + assertException (\(ErrorCallWithLocation err loc) -> err `deepseq` loc `deepseq` True) (negate sz) + prop "Show" $ \sz -> ("Just (" ++ show (sz :: Sz ix) ++ ")") === show (Just sz) eqSpecOnArbitrary @(Sz ix) ordSpecOnArbitrary @(Sz ix) diff --git a/massiv-test/tests/Test/Massiv/VectorSpec.hs b/massiv-test/tests/Test/Massiv/VectorSpec.hs index d4782b8a..c6e70f59 100644 --- a/massiv-test/tests/Test/Massiv/VectorSpec.hs +++ b/massiv-test/tests/Test/Massiv/VectorSpec.hs @@ -857,6 +857,8 @@ spec = prop "ssingleton" $ \(e :: Word) -> V.ssingleton e !==! VP.singleton e prop "replicate" $ \comp k (e :: Word) -> V.replicate @DL comp (Sz k) e !==! VP.replicate k e + prop "replicate" $ \k (e :: Word) -> + V.replicate @DS Seq (Sz k) e !==! VP.replicate k e prop "sreplicate" $ \k (e :: Word) -> V.sreplicate (Sz k) e !==! VP.replicate k e prop "generate" $ \comp k (f :: Fun Int Word) -> V.generate comp (Sz k) (apply f) !==! VP.generate k (apply f) diff --git a/massiv/CHANGELOG.md b/massiv/CHANGELOG.md index cbc79d59..61230e2e 100644 --- a/massiv/CHANGELOG.md +++ b/massiv/CHANGELOG.md @@ -1,5 +1,7 @@ # 1.0.0 +* Make `negate` in `Num` instance throw error for `Sz` in order to avoid surprising + behavior reported in: [#114](https://github.com/lehins/massiv/issues/114) * Add of `munsafeResize` * Add `uniformArray` and `uniformRangeArray` * Replace `isNonEmpty` with `isNotZeroSz` and added `isZeroSz` diff --git a/massiv/src/Data/Massiv/Array/Delayed/Push.hs b/massiv/src/Data/Massiv/Array/Delayed/Push.hs index 613fa6e3..88886aa2 100644 --- a/massiv/src/Data/Massiv/Array/Delayed/Push.hs +++ b/massiv/src/Data/Massiv/Array/Delayed/Push.hs @@ -134,7 +134,7 @@ appendOuterM (DLArray c1 sz1 load1) (DLArray c2 sz2 load2) = do (!i2, !szl2) = unconsSz sz2 unless (szl1 == szl2) $ throwM $ SizeMismatchException sz1 sz2 pure $ - DLArray {dlComp = c1 <> c2, dlSize = consSz (i1 + i2) szl1, dlLoad = load} + DLArray {dlComp = c1 <> c2, dlSize = consSz (liftSz2 (+) i1 i2) szl1, dlLoad = load} where load :: Monad n => Scheduler n () -> Ix1 -> (Ix1 -> e -> n ()) -> (Ix1 -> Sz1 -> e -> n ()) -> n () load scheduler !startAt dlWrite dlSet = do diff --git a/massiv/src/Data/Massiv/Array/Manifest/Vector.hs b/massiv/src/Data/Massiv/Array/Manifest/Vector.hs index 2f9d4db6..d320347b 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Vector.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Vector.hs @@ -23,6 +23,7 @@ module Data.Massiv.Array.Manifest.Vector ) where import Control.Monad (guard, join, msum) +import Data.Kind import Data.Massiv.Array.Manifest.Boxed import Data.Massiv.Array.Manifest.Internal import Data.Massiv.Array.Manifest.Primitive @@ -39,14 +40,14 @@ import qualified Data.Vector.Storable as VS import qualified Data.Vector.Unboxed as VU -- | Match vector type to array representation -type family ARepr (v :: * -> *) :: * where +type family ARepr (v :: Type -> Type) :: Type where ARepr VU.Vector = U ARepr VS.Vector = S ARepr VP.Vector = P ARepr VB.Vector = BL -- | Match array representation to a vector type -type family VRepr r :: * -> * where +type family VRepr r :: Type -> Type where VRepr U = VU.Vector VRepr S = VS.Vector VRepr P = VP.Vector diff --git a/massiv/src/Data/Massiv/Array/Ops/Sort.hs b/massiv/src/Data/Massiv/Array/Ops/Sort.hs index efdb4ca8..2754e0f5 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Sort.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Sort.hs @@ -47,7 +47,7 @@ import System.IO.Unsafe tally :: (Mutable r e, Load r ix e, Ord e) => Array r ix e -> Vector DS (e, Int) tally arr | isEmpty arr = setComp (getComp arr) empty - | otherwise = scatMaybes $ sunfoldrN (sz + 1) count (0, 0, sorted ! 0) + | otherwise = scatMaybes $ sunfoldrN (liftSz2 (+) sz oneSz) count (0, 0, sorted ! 0) where sz@(Sz k) = size sorted count (!i, !n, !prev) diff --git a/massiv/src/Data/Massiv/Array/Stencil.hs b/massiv/src/Data/Massiv/Array/Stencil.hs index 86362f73..a5797f69 100644 --- a/massiv/src/Data/Massiv/Array/Stencil.hs +++ b/massiv/src/Data/Massiv/Array/Stencil.hs @@ -15,7 +15,6 @@ module Data.Massiv.Array.Stencil ( -- * Stencil Stencil , makeStencil - , makeStencilDef , getStencilSize , getStencilCenter -- ** Padding @@ -253,26 +252,6 @@ makeStencil !sSz !sCenter relStencil = Stencil sSz sCenter stencil {-# INLINE stencil #-} {-# INLINE makeStencil #-} --- | Same as `makeStencil`, but with ability to specify default value for stencil validation. --- --- @since 0.2.3 -makeStencilDef - :: Index ix - => e -- ^ Default element that will be used for stencil validation only. - -> Sz ix -- ^ Size of the stencil - -> ix -- ^ Center of the stencil - -> ((ix -> e) -> a) - -- ^ Stencil function. - -> Stencil ix e a -makeStencilDef _defVal !sSz !sCenter relStencil = - Stencil sSz sCenter stencil - where - stencil _ getVal !ix = - inline relStencil $ \ !ixD -> getVal (liftIndex2 (+) ix ixD) - {-# INLINE stencil #-} -{-# INLINE makeStencilDef #-} -{-# DEPRECATED makeStencilDef "In favor of `makeStencil`. Validation is no longer possible" #-} - -- | Identity stencil that does not change the elements of the source array. -- -- @since 0.4.3 diff --git a/massiv/src/Data/Massiv/Core/Common.hs b/massiv/src/Data/Massiv/Core/Common.hs index db2bda18..7735cac1 100644 --- a/massiv/src/Data/Massiv/Core/Common.hs +++ b/massiv/src/Data/Massiv/Core/Common.hs @@ -251,7 +251,7 @@ class Index ix => Shape r ix where -- -- @since 1.0.0 isNull :: Array r ix e -> Bool - isNull = (0 ==) . linearSize + isNull = (zeroSz ==) . linearSize {-# INLINE isNull #-} @@ -267,7 +267,7 @@ class Size r where -- | Get the exact size of an immutabe array. Most of the time will produce the size in -- constant time, except for `DS` representation, which could result in evaluation of - -- the whole stream. See `maxSize` and `Data.Massiv.Vector.slength` for more info. + -- the whole stream. See `maxLinearSize` and `Data.Massiv.Vector.slength` for more info. -- -- @since 0.1.0 size :: Array r ix e -> Sz ix @@ -365,8 +365,12 @@ class (Strategy r, Shape r ix) => Load r ix e where {-# INLINE makeArrayLinear #-} + -- | Construct an array of the specified size that contains the same element in all of + -- the cells. + -- + -- @since 0.3.0 replicate :: Comp -> Sz ix -> e -> Array r ix e - replicate comp sz !e = makeArray comp sz (const e) + replicate comp sz !e = makeArrayLinear comp sz (const e) {-# INLINE replicate #-} diff --git a/massiv/src/Data/Massiv/Core/Index/Internal.hs b/massiv/src/Data/Massiv/Core/Index/Internal.hs index 4d7e721b..ddd3ef59 100644 --- a/massiv/src/Data/Massiv/Core/Index/Internal.hs +++ b/massiv/src/Data/Massiv/Core/Index/Internal.hs @@ -71,9 +71,33 @@ import Data.Massiv.Core.Iterator import Data.Typeable import GHC.TypeLits --- | `Sz` provides type safety guarantees preventing mixup with index, which is used for looking into --- array cells, from the size, that describes total number of elements along each dimension in the --- array. Moreover the @Sz@ constructor will prevent creation of invalid sizes with negative numbers. +-- | `Sz` is the size of the array. It describes total number of elements along each +-- dimension in the array. It is a wrapper around an index of the same dimension, however +-- it provides type safety preventing mixup with index. Moreover the @Sz@ constructor (and +-- others `Sz1`, `Data.Massiv.Core.Index.Sz2`, ... that are specialized to specific +-- dimensions prevent creation of invalid sizes with negative values. +-- +-- ====__Examples__ +-- +-- >>> import Data.Massiv.Array +-- >>> Sz (1 :> 2 :. 3) +-- Sz (1 :> 2 :. 3) +-- +-- `Sz` has a `Num` instance, which is very convenient: +-- +-- >>> Sz (1 :> 2 :. 3) + 5 +-- Sz (6 :> 7 :. 8) +-- +-- However subtraction can sometimes lead to surprising behavior, because size is not +-- allowed to take negative values it will be clamped at 0. +-- +-- >>> Sz (1 :> 2 :. 3) - 2 +-- Sz (0 :> 0 :. 1) +-- +-- __Warning__: It is always wrong to `negate` a size, thus it will result in an +-- error. For that reason also watch out for partially applied @(`-` sz)@, which is +-- deugared into @`negate` sz@. See more info about it in +-- [#114](https://github.com/lehins/massiv/issues/114). -- -- @since 0.3.0 newtype Sz ix = @@ -116,16 +140,20 @@ instance Index ix => Show (Sz ix) where 1 -> "1 " ++ show usz _ -> " (" ++ shows usz ")" +-- | Calling `negate` is an error. instance (Num ix, Index ix) => Num (Sz ix) where (+) x y = Sz (coerce x + coerce y) {-# INLINE (+) #-} (-) x y = Sz (coerce x - coerce y) {-# INLINE (-) #-} - (*) x y = SafeSz (coerce x * coerce y) + (*) x y = Sz (coerce x * coerce y) {-# INLINE (*) #-} abs !x = x {-# INLINE abs #-} - negate !_x = 0 + negate x + | x == zeroSz = x + | otherwise = + error $ "Attempted to negate: " ++ show x ++ ", this can lead to unexpected behavior. See #114" {-# INLINE negate #-} signum x = SafeSz (signum (coerce x)) {-# INLINE signum #-} diff --git a/massiv/src/Data/Massiv/Vector.hs b/massiv/src/Data/Massiv/Vector.hs index 27b768a9..8deeb204 100644 --- a/massiv/src/Data/Massiv/Vector.hs +++ b/massiv/src/Data/Massiv/Vector.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-duplicate-exports #-} -- | @@ -313,7 +314,7 @@ import Prelude hiding (drop, dropWhile, init, length, null, replicate, splitAt, -- | /O(1)/ - Get the length of a `Stream` array, but only if it is known exactly in -- constant time without looking at any of the elements in the array. -- --- /Related/: `maxSize`, `size`, `elemsCount` and `totalElem` +-- /Related/: `maxLinearSize`, `size`, `elemsCount` and `totalElem` -- -- ==== __Examples__ -- @@ -342,7 +343,10 @@ import Prelude hiding (drop, dropWhile, init, length, null, replicate, splitAt, -- the vector. -- -- @since 0.5.0 -slength :: Stream r ix e => Array r ix e -> Maybe Sz1 +slength :: + forall r ix e. Stream r ix e + => Array r ix e + -> Maybe Sz1 slength v = case stepsSize (toStream v) of LengthExact sz -> Just sz @@ -373,7 +377,10 @@ slength v = -- cause materialization of the full vector if any other function is applied to the vector. -- -- @since 0.5.0 -head' :: (HasCallStack, Source r e) => Vector r e -> e +head' :: + forall r e. (HasCallStack, Source r e) + => Vector r e + -> e head' = throwEither . headM {-# INLINE head' #-} @@ -401,7 +408,10 @@ head' = throwEither . headM -- except it is restricted to `Maybe` -- -- @since 0.5.0 -headM :: (Source r e, MonadThrow m) => Vector r e -> m e +headM :: + forall r e m. (Source r e, MonadThrow m) + => Vector r e + -> m e headM v | elemsCount v == 0 = throwM $ SizeEmptyException (size v) | otherwise = pure $ unsafeLinearIndex v 0 @@ -420,7 +430,10 @@ headM v -- 3 -- -- @since 0.5.0 -shead' :: (HasCallStack, Stream r Ix1 e) => Vector r e -> e +shead' :: + forall r e. (HasCallStack, Stream r Ix1 e) + => Vector r e + -> e shead' = throwEither . sheadM {-# INLINE shead' #-} @@ -442,7 +455,10 @@ shead' = throwEither . sheadM -- *** Exception: SizeEmptyException: (Sz1 0) corresponds to an empty array -- -- @since 0.5.0 -sheadM :: (Stream r Ix1 e, MonadThrow m) => Vector r e -> m e +sheadM :: + forall r e m. (Stream r Ix1 e, MonadThrow m) + => Vector r e + -> m e sheadM v = case S.unId (S.headMaybe (toStream v)) of Nothing -> throwM $ SizeEmptyException (zeroSz :: Sz1) @@ -469,7 +485,10 @@ sheadM v = -- the more general `MonadThrow` -- -- @since 0.3.0 -unconsM :: (MonadThrow m, Source r e) => Vector r e -> m (e, Vector r e) +unconsM :: + forall r e m. (MonadThrow m, Source r e) + => Vector r e + -> m (e, Vector r e) unconsM arr | 0 == totalElem sz = throwM $ SizeEmptyException sz | otherwise = pure (unsafeLinearIndex arr 0, unsafeLinearSlice 1 (SafeSz (unSz sz - 1)) arr) @@ -491,7 +510,10 @@ unconsM arr -- [ 1, 2 ],3) -- -- @since 0.3.0 -unsnocM :: (MonadThrow m, Source r e) => Vector r e -> m (Vector r e, e) +unsnocM :: + forall r e m. (MonadThrow m, Source r e) + => Vector r e + -> m (Vector r e, e) unsnocM arr | 0 == totalElem sz = throwM $ SizeEmptyException sz | otherwise = pure (unsafeLinearSlice 0 (SafeSz k) arr, unsafeLinearIndex arr k) @@ -519,7 +541,7 @@ unsnocM arr -- cause materialization of the full vector if any other function is applied to the vector. -- -- @since 0.5.0 -last' :: (HasCallStack, Source r e) => Vector r e -> e +last' :: forall r e. (HasCallStack, Source r e) => Vector r e -> e last' = throwEither . lastM {-# INLINE last' #-} @@ -540,7 +562,7 @@ last' = throwEither . lastM -- "SizeEmptyException: (Sz1 0) corresponds to an empty array" -- -- @since 0.5.0 -lastM :: (Source r e, MonadThrow m) => Vector r e -> m e +lastM :: forall r e m. (Source r e, MonadThrow m) => Vector r e -> m e lastM v | k == 0 = throwM $ SizeEmptyException (size v) | otherwise = pure $ unsafeLinearIndex v (k - 1) @@ -563,7 +585,7 @@ lastM v -- [ 9999999999998, 9999999999999, 10000000000000 ] -- -- @since 0.5.0 -slice :: Source r e => Ix1 -> Sz1 -> Vector r e -> Vector r e +slice :: forall r e. Source r e => Ix1 -> Sz1 -> Vector r e -> Vector r e slice !i (Sz k) v = unsafeLinearSlice i' newSz v where !i' = min n (max 0 i) @@ -583,7 +605,7 @@ slice !i (Sz k) v = unsafeLinearSlice i' newSz v -- [ 9999999999998, 9999999999999, 10000000000000 ] -- -- @since 0.5.0 -slice' :: (HasCallStack, Source r e) => Ix1 -> Sz1 -> Vector r e -> Vector r e +slice' :: forall r e. (HasCallStack, Source r e) => Ix1 -> Sz1 -> Vector r e -> Vector r e slice' i k = throwEither . sliceM i k {-# INLINE slice' #-} @@ -606,7 +628,15 @@ slice' i k = throwEither . sliceM i k -- [ 9999999999998, 9999999999999, 10000000000000 ] -- -- @since 0.5.0 -sliceM :: (Source r e, MonadThrow m) => Ix1 -> Sz1 -> Vector r e -> m (Vector r e) +sliceM :: + forall r e m. (Source r e, MonadThrow m) + => Ix1 + -- ^ Starting index + -> Sz1 + -- ^ Number of elements to take from the Source vector + -> Vector r e + -- ^ Source vector to take a slice from + -> m (Vector r e) sliceM i newSz@(Sz k) v | i >= 0 && k <= n - i = pure $ unsafeLinearSlice i newSz v | otherwise = throwM $ SizeSubregionException sz i newSz @@ -639,7 +669,15 @@ sliceM i newSz@(Sz k) v -- Nothing -- -- @since 0.5.0 -sslice :: Stream r Ix1 e => Ix1 -> Sz1 -> Vector r e -> Vector DS e +sslice :: + forall r e. Stream r Ix1 e + => Ix1 + -- ^ Starting index + -> Sz1 + -- ^ Number of elements to take from the stream vector + -> Vector r e + -- ^ Stream vector to take a slice from + -> Vector DS e sslice !i !k = fromSteps . S.slice i k . S.toStream {-# INLINE sslice #-} @@ -657,7 +695,7 @@ sslice !i !k = fromSteps . S.slice i k . S.toStream -- [ ] -- -- @since 0.5.0 -init :: Source r e => Vector r e -> Vector r e +init :: forall r e. Source r e => Vector r e -> Vector r e init v = unsafeLinearSlice 0 (Sz (coerce (size v) - 1)) v {-# INLINE init #-} @@ -670,7 +708,7 @@ init v = unsafeLinearSlice 0 (Sz (coerce (size v) - 1)) v -- [ 0, 1, 2, 3, 4, 5, 6, 7, 8 ] -- -- @since 0.5.0 -init' :: (HasCallStack, Source r e) => Vector r e -> Vector r e +init' :: forall r e. (HasCallStack, Source r e) => Vector r e -> Vector r e init' = throwEither . initM {-# INLINE init' #-} @@ -688,7 +726,7 @@ init' = throwEither . initM -- 0 -- -- @since 0.5.0 -initM :: (Source r e, MonadThrow m) => Vector r e -> m (Vector r e) +initM :: forall r e m. (Source r e, MonadThrow m) => Vector r e -> m (Vector r e) initM v = do when (elemsCount v == 0) $ throwM $ SizeEmptyException $ size v pure $ unsafeInit v @@ -709,8 +747,8 @@ initM v = do -- [ ] -- -- @since 0.5.0 -tail :: Source r e => Vector r e -> Vector r e -tail = drop 1 +tail :: forall r e. Source r e => Vector r e -> Vector r e +tail = drop oneSz {-# INLINE tail #-} @@ -725,7 +763,7 @@ tail = drop 1 -- Array D *** Exception: SizeEmptyException: (Sz1 0) corresponds to an empty array -- -- @since 0.5.0 -tail' :: (HasCallStack, Source r e) => Vector r e -> Vector r e +tail' :: forall r e. (HasCallStack, Source r e) => Vector r e -> Vector r e tail' = throwEither . tailM {-# INLINE tail' #-} @@ -744,7 +782,7 @@ tail' = throwEither . tailM -- 0 -- -- @since 0.5.0 -tailM :: (Source r e, MonadThrow m) => Vector r e -> m (Vector r e) +tailM :: forall r e m. (Source r e, MonadThrow m) => Vector r e -> m (Vector r e) tailM v = do when (elemsCount v == 0) $ throwM $ SizeEmptyException $ size v pure $ unsafeTail v @@ -787,8 +825,6 @@ takeWhile f v = take (go 0) v {-# INLINE takeWhile #-} - - -- | /O(1)/ - Get the vector with the first @n@ elements. Throws an error size is less -- than @n@. -- @@ -802,7 +838,7 @@ takeWhile f v = take (go 0) v -- [ 0, 1, 2, 3, 4 ] -- -- @since 0.5.0 -take' :: (HasCallStack, Source r e) => Sz1 -> Vector r e -> Vector r e +take' :: forall r e. (HasCallStack, Source r e) => Sz1 -> Vector r e -> Vector r e take' k = throwEither . takeM k {-# INLINE take' #-} @@ -822,7 +858,7 @@ take' k = throwEither . takeM k -- *** Exception: SizeSubregionException: (Sz1 10) is to small for 0 (Sz1 15) -- -- @since 0.5.0 -takeM :: (Source r e, MonadThrow m) => Sz1 -> Vector r e -> m (Vector r e) +takeM :: forall r e m. (Source r e, MonadThrow m) => Sz1 -> Vector r e -> m (Vector r e) takeM k v = do let sz = size v when (k > sz) $ throwM $ SizeSubregionException sz 0 k @@ -834,7 +870,7 @@ takeM k v = do -- ==== __Examples__ -- -- @since 0.5.0 -stake :: Stream r Ix1 e => Sz1 -> Vector r e -> Vector DS e +stake :: forall r e. Stream r Ix1 e => Sz1 -> Vector r e -> Vector DS e stake n = fromSteps . S.take n . S.toStream {-# INLINE stake #-} @@ -843,7 +879,7 @@ stake n = fromSteps . S.take n . S.toStream -- ==== __Examples__ -- -- @since 0.5.0 -drop :: Source r e => Sz1 -> Vector r e -> Vector r e +drop :: forall r e. Source r e => Sz1 -> Vector r e -> Vector r e drop k = snd . sliceAt k {-# INLINE drop #-} @@ -852,7 +888,7 @@ drop k = snd . sliceAt k -- that satisfy the supplied predicate. -- -- @since 0.5.5 -dropWhile :: Manifest r e => (e -> Bool) -> Vector r e -> Vector r e +dropWhile :: forall r e. Manifest r e => (e -> Bool) -> Vector r e -> Vector r e dropWhile f v = drop (go 0) v where !k = elemsCount v @@ -867,7 +903,7 @@ dropWhile f v = drop (go 0) v -- ==== __Examples__ -- -- @since 0.5.0 -sdrop :: Stream r Ix1 e => Sz1 -> Vector r e -> Vector DS e +sdrop :: forall r e. Stream r Ix1 e => Sz1 -> Vector r e -> Vector DS e sdrop n = fromSteps . S.drop n . S.toStream {-# INLINE sdrop #-} @@ -876,7 +912,7 @@ sdrop n = fromSteps . S.drop n . S.toStream -- ==== __Examples__ -- -- @since 0.5.0 -drop' :: (HasCallStack, Source r e) => Sz1 -> Vector r e -> Vector r e +drop' :: forall r e. (HasCallStack, Source r e) => Sz1 -> Vector r e -> Vector r e drop' k = throwEither . dropM k {-# INLINE drop' #-} @@ -885,10 +921,10 @@ drop' k = throwEither . dropM k -- ==== __Examples__ -- -- @since 0.5.0 -dropM :: (Source r e, MonadThrow m) => Sz1 -> Vector r e -> m (Vector r e) +dropM :: forall r e m. (Source r e, MonadThrow m) => Sz1 -> Vector r e -> m (Vector r e) dropM k@(Sz d) v = do let sz@(Sz n) = size v - when (k > sz) $ throwM $ SizeSubregionException sz d (sz - k) + when (k > sz) $ throwM $ SizeSubregionException sz d (SafeSz (n - d)) pure $ unsafeLinearSlice d (SafeSz (n - d)) v {-# INLINE dropM #-} @@ -899,7 +935,7 @@ dropM k@(Sz d) v = do -- ==== __Examples__ -- -- @since 0.5.0 -sliceAt :: Source r e => Sz1 -> Vector r e -> (Vector r e, Vector r e) +sliceAt :: forall r e. Source r e => Sz1 -> Vector r e -> (Vector r e, Vector r e) sliceAt (Sz k) v = (unsafeTake d v, unsafeDrop d v) where !n = coerce (size v) @@ -920,7 +956,7 @@ sliceAt' k = throwEither . sliceAtM k -- ==== __Examples__ -- -- @since 0.5.0 -sliceAtM :: (Source r e, MonadThrow m) => Sz1 -> Vector r e -> m (Vector r e, Vector r e) +sliceAtM :: forall r e m. (Source r e, MonadThrow m) => Sz1 -> Vector r e -> m (Vector r e, Vector r e) sliceAtM k v = do l <- takeM k v pure (l, unsafeDrop k v) @@ -948,7 +984,7 @@ ssingleton = DSArray . S.singleton -- | /O(1)/ - Add an element to the vector from the left side -- -- @since 0.3.0 -cons :: (Size r, Load r Ix1 e) => e -> Vector r e -> Vector DL e +cons :: forall r e. (Size r, Load r Ix1 e) => e -> Vector r e -> Vector DL e cons e v = let dv = toLoadArray v load scheduler startAt uWrite uSet = @@ -960,7 +996,7 @@ cons e v = -- | /O(1)/ - Add an element to the vector from the right side -- -- @since 0.3.0 -snoc :: (Size r, Load r Ix1 e) => Vector r e -> e -> Vector DL e +snoc :: forall r e. (Size r, Load r Ix1 e) => Vector r e -> e -> Vector DL e snoc v e = let dv = toLoadArray v !k = unSz (size dv) @@ -1036,7 +1072,7 @@ siterateN n f a = fromSteps $ S.iterateN n f a -- ==== __Examples__ -- -- @since 0.5.0 -sreplicateM :: Monad m => Sz1 -> m e -> m (Vector DS e) +sreplicateM :: forall e m. Monad m => Sz1 -> m e -> m (Vector DS e) sreplicateM n f = fromStepsM $ S.replicateM n f {-# INLINE sreplicateM #-} @@ -1047,7 +1083,7 @@ sreplicateM n f = fromStepsM $ S.replicateM n f -- ==== __Examples__ -- -- @since 0.5.0 -sgenerateM :: Monad m => Sz1 -> (Ix1 -> m e) -> m (Vector DS e) +sgenerateM :: forall e m. Monad m => Sz1 -> (Ix1 -> m e) -> m (Vector DS e) sgenerateM n f = fromStepsM $ S.generateM n f {-# INLINE sgenerateM #-} @@ -1058,7 +1094,7 @@ sgenerateM n f = fromStepsM $ S.generateM n f -- ==== __Examples__ -- -- @since 0.5.0 -siterateNM :: Monad m => Sz1 -> (e -> m e) -> e -> m (Vector DS e) +siterateNM :: forall e m. Monad m => Sz1 -> (e -> m e) -> e -> m (Vector DS e) siterateNM n f a = fromStepsM $ S.iterateNM n f a {-# INLINE siterateNM #-} @@ -1076,7 +1112,7 @@ siterateNM n f a = fromStepsM $ S.iterateNM n f a -- [ 0, 1, 4, 9, 16, 25, 36, 49, 64 ] -- -- @since 0.5.0 -sunfoldr :: (s -> Maybe (e, s)) -> s -> Vector DS e +sunfoldr :: forall e s. (s -> Maybe (e, s)) -> s -> Vector DS e sunfoldr f = DSArray . S.unfoldr f {-# INLINE sunfoldr #-} @@ -1093,6 +1129,7 @@ sunfoldr f = DSArray . S.unfoldr f -- -- @since 0.5.0 sunfoldrN :: + forall e s. Sz1 -- ^ @n@ - maximum number of elements that the vector will have -> (s -> Maybe (e, s)) @@ -1116,7 +1153,7 @@ sunfoldrN n f = DSArray . S.unfoldrN n f -- ) -- -- @since 0.5.0 -sunfoldrM :: Monad m => (s -> m (Maybe (e, s))) -> s -> m (Vector DS e) +sunfoldrM :: forall e s m. Monad m => (s -> m (Maybe (e, s))) -> s -> m (Vector DS e) sunfoldrM f = fromStepsM . S.unfoldrM f {-# INLINE sunfoldrM #-} @@ -1141,7 +1178,7 @@ sunfoldrM f = fromStepsM . S.unfoldrM f -- -- -- @since 0.5.0 -sunfoldrNM :: Monad m => Sz1 -> (s -> m (Maybe (e, s))) -> s -> m (Vector DS e) +sunfoldrNM :: forall e s m. Monad m => Sz1 -> (s -> m (Maybe (e, s))) -> s -> m (Vector DS e) sunfoldrNM (Sz n) f = fromStepsM . S.unfoldrNM n f {-# INLINE sunfoldrNM #-} @@ -1155,7 +1192,7 @@ sunfoldrNM (Sz n) f = fromStepsM . S.unfoldrNM n f -- [ 100, 121, 144, 169, 196, 225, 256, 289, 324, 361 ] -- -- @since 0.5.0 -sunfoldrExactN :: Sz1 -> (s -> (e, s)) -> s -> Vector DS e +sunfoldrExactN :: forall e s. Sz1 -> (s -> (e, s)) -> s -> Vector DS e sunfoldrExactN n f = fromSteps . S.unfoldrExactN n f {-# INLINE sunfoldrExactN #-} @@ -1173,7 +1210,7 @@ sunfoldrExactN n f = fromSteps . S.unfoldrExactN n f -- ) -- -- @since 0.5.0 -sunfoldrExactNM :: Monad m => Sz1 -> (s -> m (e, s)) -> s -> m (Vector DS e) +sunfoldrExactNM :: forall e s m. Monad m => Sz1 -> (s -> m (e, s)) -> s -> m (Vector DS e) sunfoldrExactNM n f = fromStepsM . S.unfoldrExactNM n f {-# INLINE sunfoldrExactNM #-} @@ -1257,7 +1294,11 @@ senumFromStepN x step n = DSArray $ S.enumFromStepN x step n -- memory representations. -- -- @since 0.5.0 -sappend :: (Stream r1 Ix1 e, Stream r2 Ix1 e) => Vector r1 e -> Vector r2 e -> Vector DS e +sappend :: + forall r1 r2 e. (Stream r1 Ix1 e, Stream r2 Ix1 e) + => Vector r1 e + -> Vector r2 e + -> Vector DS e sappend a1 a2 = fromSteps (toStream a1 `S.append` toStream a2) {-# INLINE sappend #-} @@ -1287,7 +1328,7 @@ sappend a1 a2 = fromSteps (toStream a1 `S.append` toStream a2) -- implementation underneath as `sconcat`. -- -- @since 0.5.0 -sconcat :: Stream r Ix1 e => [Vector r e] -> Vector DS e +sconcat :: forall r e. Stream r Ix1 e => [Vector r e] -> Vector DS e sconcat = DSArray . foldMap toStream {-# INLINE sconcat #-} @@ -1336,15 +1377,12 @@ sfromListN (Sz n) = fromSteps . S.fromListN n -- ==== __Examples__ -- -- @since 0.5.0 -stoList :: Stream r ix e => Array r ix e -> [e] +stoList :: forall r ix e. Stream r ix e => Array r ix e -> [e] stoList = S.toList . toStream {-# INLINE stoList #-} - - - -- | Sequentially filter out elements from the array according to the supplied predicate. -- -- ==== __Example__ @@ -1362,7 +1400,7 @@ stoList = S.toList . toStream -- [ (0,0), (0,1), (0,2), (0,3), (2,0), (2,1), (2,2), (2,3) ] -- -- @since 0.5.0 -sfilter :: S.Stream r ix e => (e -> Bool) -> Array r ix e -> Vector DS e +sfilter :: forall r ix e. S.Stream r ix e => (e -> Bool) -> Array r ix e -> Vector DS e sfilter f = DSArray . S.filter f . S.toStream {-# INLINE sfilter #-} @@ -1372,7 +1410,7 @@ sfilter f = DSArray . S.filter f . S.toStream -- ==== __Examples__ -- -- @since 0.5.0 -sifilter :: Stream r ix a => (ix -> a -> Bool) -> Array r ix a -> Vector DS a +sifilter :: forall r ix e. Stream r ix e => (ix -> e -> Bool) -> Array r ix e -> Vector DS e sifilter f = simapMaybe $ \ix e -> if f ix e @@ -1414,7 +1452,11 @@ sifilter f = -- [ (0,0), (0,2), (1,0), (1,2), (2,0), (2,2) ] -- -- @since 0.5.0 -sfilterM :: (S.Stream r ix e, Applicative f) => (e -> f Bool) -> Array r ix e -> f (Vector DS e) +sfilterM :: + forall r ix e f. (S.Stream r ix e, Applicative f) + => (e -> f Bool) + -> Array r ix e + -> f (Vector DS e) sfilterM f arr = DSArray <$> S.filterA f (S.toStream arr) {-# INLINE sfilterM #-} @@ -1425,7 +1467,10 @@ sfilterM f arr = DSArray <$> S.filterA f (S.toStream arr) -- -- @since 0.5.0 sifilterM :: - (Stream r ix a, Applicative f) => (ix -> a -> f Bool) -> Array r ix a -> f (Vector DS a) + forall r ix e f. (Stream r ix e, Applicative f) + => (ix -> e -> f Bool) + -> Array r ix e + -> f (Vector DS e) sifilterM f = simapMaybeM $ \ix e -> (\p -> @@ -1442,7 +1487,7 @@ sifilterM f = -- ==== __Examples__ -- -- @since 0.5.0 -smapMaybe :: S.Stream r ix a => (a -> Maybe b) -> Array r ix a -> Vector DS b +smapMaybe :: forall r ix a b. S.Stream r ix a => (a -> Maybe b) -> Array r ix a -> Vector DS b smapMaybe f = DSArray . S.mapMaybe f . S.toStream {-# INLINE smapMaybe #-} @@ -1452,7 +1497,11 @@ smapMaybe f = DSArray . S.mapMaybe f . S.toStream -- ==== __Examples__ -- -- @since 0.5.0 -simapMaybe :: Stream r ix a => (ix -> a -> Maybe b) -> Array r ix a -> Vector DS b +simapMaybe :: + forall r ix a b. Stream r ix a + => (ix -> a -> Maybe b) + -> Array r ix a + -> Vector DS b simapMaybe f = DSArray . S.mapMaybe (uncurry f) . toStreamIx {-# INLINE simapMaybe #-} @@ -1462,7 +1511,10 @@ simapMaybe f = DSArray . S.mapMaybe (uncurry f) . toStreamIx -- -- @since 0.5.0 simapMaybeM :: - (Stream r ix a, Applicative f) => (ix -> a -> f (Maybe b)) -> Array r ix a -> f (Vector DS b) + forall r ix a b f. (Stream r ix a, Applicative f) + => (ix -> a -> f (Maybe b)) + -> Array r ix a + -> f (Vector DS b) simapMaybeM f = fmap DSArray . S.mapMaybeA (uncurry f) . toStreamIx {-# INLINE simapMaybeM #-} @@ -1472,7 +1524,7 @@ simapMaybeM f = fmap DSArray . S.mapMaybeA (uncurry f) . toStreamIx -- ==== __Examples__ -- -- @since 0.5.0 -scatMaybes :: S.Stream r ix (Maybe a) => Array r ix (Maybe a) -> Vector DS a +scatMaybes :: forall r ix a. S.Stream r ix (Maybe a) => Array r ix (Maybe a) -> Vector DS a scatMaybes = smapMaybe id {-# INLINE scatMaybes #-} @@ -1485,7 +1537,10 @@ scatMaybes = smapMaybe id -- -- @since 0.5.0 smapMaybeM :: - (S.Stream r ix a, Applicative f) => (a -> f (Maybe b)) -> Array r ix a -> f (Vector DS b) + forall r ix a b f. (S.Stream r ix a, Applicative f) + => (a -> f (Maybe b)) + -> Array r ix a + -> f (Vector DS b) smapMaybeM f = fmap DSArray . S.mapMaybeA f . S.toStream {-# INLINE smapMaybeM #-} @@ -1496,7 +1551,11 @@ smapMaybeM f = fmap DSArray . S.mapMaybeA f . S.toStream -- ==== __Examples__ -- -- @since 0.5.0 -smap :: S.Stream r ix a => (a -> b) -> Array r ix a -> Vector DS b +smap :: + forall r ix a b. S.Stream r ix a + => (a -> b) + -> Array r ix a + -> Vector DS b smap f = fromSteps . S.map f . S.toStream {-# INLINE smap #-} @@ -1505,7 +1564,11 @@ smap f = fromSteps . S.map f . S.toStream -- ==== __Examples__ -- -- @since 0.5.0 -simap :: S.Stream r ix a => (ix -> a -> b) -> Array r ix a -> Vector DS b +simap :: + forall r ix a b. S.Stream r ix a + => (ix -> a -> b) + -> Array r ix a + -> Vector DS b simap f = fromSteps . S.map (uncurry f) . S.toStreamIx {-# INLINE simap #-} @@ -1515,7 +1578,11 @@ simap f = fromSteps . S.map (uncurry f) . S.toStreamIx -- ==== __Examples__ -- -- @since 0.5.0 -straverse :: (S.Stream r ix a, Applicative f) => (a -> f b) -> Array r ix a -> f (Vector DS b) +straverse :: + forall r ix a b f. (S.Stream r ix a, Applicative f) + => (a -> f b) + -> Array r ix a + -> f (Vector DS b) straverse f = fmap fromSteps . S.traverse f . S.toStream {-# INLINE straverse #-} @@ -1525,7 +1592,11 @@ straverse f = fmap fromSteps . S.traverse f . S.toStream -- ==== __Examples__ -- -- @since 0.5.0 -sitraverse :: (S.Stream r ix a, Applicative f) => (ix -> a -> f b) -> Array r ix a -> f (Vector DS b) +sitraverse :: + forall r ix a b f. (S.Stream r ix a, Applicative f) + => (ix -> a -> f b) + -> Array r ix a + -> f (Vector DS b) sitraverse f = fmap fromSteps . S.traverse (uncurry f) . S.toStreamIx {-# INLINE sitraverse #-} @@ -1535,7 +1606,11 @@ sitraverse f = fmap fromSteps . S.traverse (uncurry f) . S.toStreamIx -- ==== __Examples__ -- -- @since 0.5.0 -smapM :: (S.Stream r ix a, Monad m) => (a -> m b) -> Array r ix a -> m (Vector DS b) +smapM :: + forall r ix a b m. (S.Stream r ix a, Monad m) + => (a -> m b) + -> Array r ix a + -> m (Vector DS b) smapM f = fromStepsM . S.mapM f . S.transStepsId . S.toStream {-# INLINE smapM #-} @@ -1546,7 +1621,11 @@ smapM f = fromStepsM . S.mapM f . S.transStepsId . S.toStream -- ==== __Examples__ -- -- @since 0.5.0 -simapM :: (S.Stream r ix a, Monad m) => (ix -> a -> m b) -> Array r ix a -> m (Vector DS b) +simapM :: + forall r ix a b m. (S.Stream r ix a, Monad m) + => (ix -> a -> m b) + -> Array r ix a + -> m (Vector DS b) simapM f = fromStepsM . S.mapM (uncurry f) . S.transStepsId . S.toStreamIx {-# INLINE simapM #-} @@ -1555,7 +1634,11 @@ simapM f = fromStepsM . S.mapM (uncurry f) . S.transStepsId . S.toStreamIx -- ==== __Examples__ -- -- @since 0.5.0 -smapM_ :: (S.Stream r ix a, Monad m) => (a -> m b) -> Array r ix a -> m () +smapM_ :: + forall r ix a b m. (S.Stream r ix a, Monad m) + => (a -> m b) + -> Array r ix a + -> m () smapM_ f = S.mapM_ f . S.transStepsId . S.toStream {-# INLINE smapM_ #-} @@ -1564,7 +1647,11 @@ smapM_ f = S.mapM_ f . S.transStepsId . S.toStream -- ==== __Examples__ -- -- @since 0.5.0 -simapM_ :: (S.Stream r ix a, Monad m) => (ix -> a -> m b) -> Array r ix a -> m () +simapM_ :: + forall r ix a b m. (S.Stream r ix a, Monad m) + => (ix -> a -> m b) + -> Array r ix a + -> m () simapM_ f = S.mapM_ (uncurry f) . S.transStepsId . S.toStreamIx {-# INLINE simapM_ #-} @@ -1574,7 +1661,11 @@ simapM_ f = S.mapM_ (uncurry f) . S.transStepsId . S.toStreamIx -- ==== __Examples__ -- -- @since 0.5.0 -sforM :: (S.Stream r ix a, Monad m) => Array r ix a -> (a -> m b) -> m (Vector DS b) +sforM :: + forall r ix a b m. (S.Stream r ix a, Monad m) + => Array r ix a + -> (a -> m b) + -> m (Vector DS b) sforM = flip smapM {-# INLINE sforM #-} @@ -1583,7 +1674,11 @@ sforM = flip smapM -- ==== __Examples__ -- -- @since 0.5.0 -siforM :: (S.Stream r ix a, Monad m) => Array r ix a -> (ix -> a -> m b) -> m (Vector DS b) +siforM :: + forall r ix a b m. (S.Stream r ix a, Monad m) + => Array r ix a + -> (ix -> a -> m b) + -> m (Vector DS b) siforM = flip simapM {-# INLINE siforM #-} @@ -1601,7 +1696,11 @@ sforM_ = flip smapM_ -- ==== __Examples__ -- -- @since 0.5.0 -siforM_ :: (S.Stream r ix a, Monad m) => Array r ix a -> (ix -> a -> m b) -> m () +siforM_ :: + forall r ix a b m. (S.Stream r ix a, Monad m) + => Array r ix a + -> (ix -> a -> m b) + -> m () siforM_ = flip simapM_ {-# INLINE siforM_ #-} @@ -1614,7 +1713,10 @@ siforM_ = flip simapM_ -- -- @since 0.5.0 szip :: - (S.Stream ra Ix1 a, S.Stream rb Ix1 b) => Vector ra a -> Vector rb b -> Vector DS (a, b) + forall ra rb a b. (S.Stream ra Ix1 a, S.Stream rb Ix1 b) + => Vector ra a + -> Vector rb b + -> Vector DS (a, b) szip = szipWith (,) {-# INLINE szip #-} @@ -1622,7 +1724,7 @@ szip = szipWith (,) -- -- @since 0.5.0 szip3 :: - (S.Stream ra Ix1 a, S.Stream rb Ix1 b, S.Stream rc Ix1 c) + forall ra rb rc a b c. (S.Stream ra Ix1 a, S.Stream rb Ix1 b, S.Stream rc Ix1 c) => Vector ra a -> Vector rb b -> Vector rc c @@ -1634,6 +1736,7 @@ szip3 = szipWith3 (,,) -- -- @since 0.5.0 szip4 :: + forall ra rb rc rd a b c d. (S.Stream ra Ix1 a, S.Stream rb Ix1 b, S.Stream rc Ix1 c, S.Stream rd Ix1 d) => Vector ra a -> Vector rb b @@ -1647,6 +1750,7 @@ szip4 = szipWith4 (,,,) -- -- @since 0.5.0 szip5 :: + forall ra rb rc rd re a b c d e. (S.Stream ra Ix1 a, S.Stream rb Ix1 b, S.Stream rc Ix1 c, S.Stream rd Ix1 d, S.Stream re Ix1 e) => Vector ra a -> Vector rb b @@ -1661,6 +1765,7 @@ szip5 = szipWith5 (,,,,) -- -- @since 0.5.0 szip6 :: + forall ra rb rc rd re rf a b c d e f. ( S.Stream ra Ix1 a , S.Stream rb Ix1 b , S.Stream rc Ix1 c @@ -1689,6 +1794,7 @@ szip6 = szipWith6 (,,,,,) -- -- @since 0.5.0 szipWith :: + forall ra rb a b c. (S.Stream ra Ix1 a, S.Stream rb Ix1 b) => (a -> b -> c) -> Vector ra a @@ -1701,6 +1807,7 @@ szipWith f v1 v2 = fromSteps $ S.zipWith f (S.toStream v1) (S.toStream v2) -- -- @since 0.5.0 szipWith3 :: + forall ra rb rc a b c d. (S.Stream ra Ix1 a, S.Stream rb Ix1 b, S.Stream rc Ix1 c) => (a -> b -> c -> d) -> Vector ra a @@ -1714,6 +1821,7 @@ szipWith3 f v1 v2 v3 = fromSteps $ S.zipWith3 f (S.toStream v1) (S.toStream v2) -- -- @since 0.5.0 szipWith4 :: + forall ra rb rc rd a b c d e. (S.Stream ra Ix1 a, S.Stream rb Ix1 b, S.Stream rc Ix1 c, S.Stream rd Ix1 d) => (a -> b -> c -> d -> e) -> Vector ra a @@ -1729,6 +1837,7 @@ szipWith4 f v1 v2 v3 v4 = -- -- @since 0.5.0 szipWith5 :: + forall ra rb rc rd re a b c d e f. (S.Stream ra Ix1 a, S.Stream rb Ix1 b, S.Stream rc Ix1 c, S.Stream rd Ix1 d, S.Stream re Ix1 e) => (a -> b -> c -> d -> e -> f) -> Vector ra a @@ -1746,6 +1855,7 @@ szipWith5 f v1 v2 v3 v4 v5 = -- -- @since 0.5.0 szipWith6 :: + forall ra rb rc rd re rf a b c d e f g. ( S.Stream ra Ix1 a , S.Stream rb Ix1 b , S.Stream rc Ix1 c @@ -1779,6 +1889,7 @@ szipWith6 f v1 v2 v3 v4 v5 v6 = -- -- @since 0.5.0 sizipWith :: + forall ra rb a b c. (S.Stream ra Ix1 a, S.Stream rb Ix1 b) => (Ix1 -> a -> b -> c) -> Vector ra a @@ -1791,6 +1902,7 @@ sizipWith f v1 v2 = fromSteps $ S.zipWith (uncurry f) (S.toStreamIx v1) (S.toStr -- -- @since 0.5.0 sizipWith3 :: + forall ra rb rc a b c d. (S.Stream ra Ix1 a, S.Stream rb Ix1 b, S.Stream rc Ix1 c) => (Ix1 -> a -> b -> c -> d) -> Vector ra a @@ -1805,6 +1917,7 @@ sizipWith3 f v1 v2 v3 = -- -- @since 0.5.0 sizipWith4 :: + forall ra rb rc rd a b c d e. (S.Stream ra Ix1 a, S.Stream rb Ix1 b, S.Stream rc Ix1 c, S.Stream rd Ix1 d) => (Ix1 -> a -> b -> c -> d -> e) -> Vector ra a @@ -1821,6 +1934,7 @@ sizipWith4 f v1 v2 v3 v4 = -- -- @since 0.5.0 sizipWith5 :: + forall ra rb rc rd re a b c d e f. (S.Stream ra Ix1 a, S.Stream rb Ix1 b, S.Stream rc Ix1 c, S.Stream rd Ix1 d, S.Stream re Ix1 e) => (Ix1 -> a -> b -> c -> d -> e -> f) -> Vector ra a @@ -1844,6 +1958,7 @@ sizipWith5 f v1 v2 v3 v4 v5 = -- -- @since 0.5.0 sizipWith6 :: + forall ra rb rc rd re rf a b c d e f g. ( S.Stream ra Ix1 a , S.Stream rb Ix1 b , S.Stream rc Ix1 c @@ -1878,6 +1993,7 @@ sizipWith6 f v1 v2 v3 v4 v5 v6 = -- -- @since 0.5.0 szipWithM :: + forall ra rb a b c m. (S.Stream ra Ix1 a, S.Stream rb Ix1 b, Monad m) => (a -> b -> m c) -> Vector ra a @@ -1890,6 +2006,7 @@ szipWithM f v1 v2 = fromStepsM $ S.zipWithM f (toStreamM v1) (toStreamM v2) -- -- @since 0.5.0 szipWith3M :: + forall ra rb rc a b c d m. (S.Stream ra Ix1 a, S.Stream rb Ix1 b, S.Stream rc Ix1 c, Monad m) => (a -> b -> c -> m d) -> Vector ra a @@ -1903,6 +2020,7 @@ szipWith3M f v1 v2 v3 = fromStepsM $ S.zipWith3M f (toStreamM v1) (toStreamM v2) -- -- @since 0.5.0 szipWith4M :: + forall ra rb rc rd a b c d e m. (S.Stream ra Ix1 a, S.Stream rb Ix1 b, S.Stream rc Ix1 c, S.Stream rd Ix1 d, Monad m) => (a -> b -> c -> d -> m e) -> Vector ra a @@ -1918,6 +2036,7 @@ szipWith4M f v1 v2 v3 v4 = -- -- @since 0.5.0 szipWith5M :: + forall ra rb rc rd re a b c d e f m. ( S.Stream ra Ix1 a , S.Stream rb Ix1 b , S.Stream rc Ix1 c @@ -1941,6 +2060,7 @@ szipWith5M f v1 v2 v3 v4 v5 = -- -- @since 0.5.0 szipWith6M :: + forall ra rb rc rd re rf a b c d e f g m. ( S.Stream ra Ix1 a , S.Stream rb Ix1 b , S.Stream rc Ix1 c @@ -1976,6 +2096,7 @@ szipWith6M f v1 v2 v3 v4 v5 v6 = -- -- @since 0.5.0 sizipWithM :: + forall ra rb a b c m. (S.Stream ra Ix1 a, S.Stream rb Ix1 b, Monad m) => (Ix1 -> a -> b -> m c) -> Vector ra a @@ -1989,6 +2110,7 @@ sizipWithM f v1 v2 = fromStepsM $ S.zipWithM (uncurry f) (toStreamIxM v1) (toStr -- -- @since 0.5.0 sizipWith3M :: + forall ra rb rc a b c d m. (S.Stream ra Ix1 a, S.Stream rb Ix1 b, S.Stream rc Ix1 c, Monad m) => (Ix1 -> a -> b -> c -> m d) -> Vector ra a @@ -2003,6 +2125,7 @@ sizipWith3M f v1 v2 v3 = -- -- @since 0.5.0 sizipWith4M :: + forall ra rb rc rd a b c d e m. (S.Stream ra Ix1 a, S.Stream rb Ix1 b, S.Stream rc Ix1 c, S.Stream rd Ix1 d, Monad m) => (Ix1 -> a -> b -> c -> d -> m e) -> Vector ra a @@ -2019,6 +2142,7 @@ sizipWith4M f v1 v2 v3 v4 = -- -- @since 0.5.0 sizipWith5M :: + forall ra rb rc rd re a b c d e f m. ( S.Stream ra Ix1 a , S.Stream rb Ix1 b , S.Stream rc Ix1 c @@ -2050,6 +2174,7 @@ sizipWith5M f v1 v2 v3 v4 v5 = -- -- @since 0.5.0 sizipWith6M :: + forall ra rb rc rd re rf a b c d e f g m. ( S.Stream ra Ix1 a , S.Stream rb Ix1 b , S.Stream rc Ix1 c @@ -2085,7 +2210,7 @@ sizipWith6M f v1 v2 v3 v4 v5 v6 = -- -- @since 0.5.0 szipWithM_ :: - (S.Stream ra Ix1 a, S.Stream rb Ix1 b, Monad m) + forall ra rb a b c m. (S.Stream ra Ix1 a, S.Stream rb Ix1 b, Monad m) => (a -> b -> m c) -> Vector ra a -> Vector rb b @@ -2097,6 +2222,7 @@ szipWithM_ f v1 v2 = S.zipWithM_ f (toStreamM v1) (toStreamM v2) -- -- @since 0.5.0 szipWith3M_ :: + forall ra rb rc a b c d m. (S.Stream ra Ix1 a, S.Stream rb Ix1 b, S.Stream rc Ix1 c, Monad m) => (a -> b -> c -> m d) -> Vector ra a @@ -2110,6 +2236,7 @@ szipWith3M_ f v1 v2 v3 = S.zipWith3M_ f (toStreamM v1) (toStreamM v2) (toStreamM -- -- @since 0.5.0 szipWith4M_ :: + forall ra rb rc rd a b c d e m. (S.Stream ra Ix1 a, S.Stream rb Ix1 b, S.Stream rc Ix1 c, S.Stream rd Ix1 d, Monad m) => (a -> b -> c -> d -> m e) -> Vector ra a @@ -2125,6 +2252,7 @@ szipWith4M_ f v1 v2 v3 v4 = -- -- @since 0.5.0 szipWith5M_ :: + forall ra rb rc rd re a b c d e f m. ( S.Stream ra Ix1 a , S.Stream rb Ix1 b , S.Stream rc Ix1 c @@ -2147,6 +2275,7 @@ szipWith5M_ f v1 v2 v3 v4 v5 = -- -- @since 0.5.0 szipWith6M_ :: + forall ra rb rc rd re rf a b c d e f g m. ( S.Stream ra Ix1 a , S.Stream rb Ix1 b , S.Stream rc Ix1 c @@ -2183,7 +2312,7 @@ szipWith6M_ f v1 v2 v3 v4 v5 v6 = -- -- @since 0.5.0 sizipWithM_ :: - (S.Stream ra Ix1 a, S.Stream rb Ix1 b, Monad m) + forall ra rb a b c m. (S.Stream ra Ix1 a, S.Stream rb Ix1 b, Monad m) => (Ix1 -> a -> b -> m c) -> Vector ra a -> Vector rb b @@ -2196,6 +2325,7 @@ sizipWithM_ f v1 v2 = S.zipWithM_ (uncurry f) (toStreamIxM v1) (toStreamM v2) -- -- @since 0.5.0 sizipWith3M_ :: + forall ra rb rc a b c d m. (S.Stream ra Ix1 a, S.Stream rb Ix1 b, S.Stream rc Ix1 c, Monad m) => (Ix1 -> a -> b -> c -> m d) -> Vector ra a @@ -2209,6 +2339,7 @@ sizipWith3M_ f v1 v2 v3 = S.zipWith3M_ (uncurry f) (toStreamIxM v1) (toStreamM v -- -- @since 0.5.0 sizipWith4M_ :: + forall ra rb rc rd a b c d e m. (S.Stream ra Ix1 a, S.Stream rb Ix1 b, S.Stream rc Ix1 c, S.Stream rd Ix1 d, Monad m) => (Ix1 -> a -> b -> c -> d -> m e) -> Vector ra a @@ -2224,6 +2355,7 @@ sizipWith4M_ f v1 v2 v3 v4 = -- -- @since 0.5.0 sizipWith5M_ :: + forall ra rb rc rd re a b c d e f m. ( S.Stream ra Ix1 a , S.Stream rb Ix1 b , S.Stream rc Ix1 c @@ -2252,6 +2384,7 @@ sizipWith5M_ f v1 v2 v3 v4 v5 = -- -- @since 0.5.0 sizipWith6M_ :: + forall ra rb rc rd re rf a b c d e f g m. ( S.Stream ra Ix1 a , S.Stream rb Ix1 b , S.Stream rc Ix1 c @@ -2288,7 +2421,12 @@ sizipWith6M_ f v1 v2 v3 v4 v5 v6 = -- ==== __Examples__ -- -- @since 0.5.0 -sfoldl :: Stream r ix e => (a -> e -> a) -> a -> Array r ix e -> a +sfoldl :: + forall r ix e a. Stream r ix e + => (a -> e -> a) + -> a + -> Array r ix e + -> a sfoldl f acc = S.unId . S.foldl f acc . toStream {-# INLINE sfoldl #-} @@ -2297,7 +2435,12 @@ sfoldl f acc = S.unId . S.foldl f acc . toStream -- ==== __Examples__ -- -- @since 0.5.0 -sfoldlM :: (Stream r ix e, Monad m) => (a -> e -> m a) -> a -> Array r ix e -> m a +sfoldlM :: + forall r ix e a m. (Stream r ix e, Monad m) + => (a -> e -> m a) + -> a + -> Array r ix e + -> m a sfoldlM f acc = S.foldlM f acc . S.transStepsId . toStream {-# INLINE sfoldlM #-} @@ -2306,7 +2449,12 @@ sfoldlM f acc = S.foldlM f acc . S.transStepsId . toStream -- ==== __Examples__ -- -- @since 0.5.0 -sfoldlM_ :: (Stream r ix e, Monad m) => (a -> e -> m a) -> a -> Array r ix e -> m () +sfoldlM_ :: + forall r ix e a m. (Stream r ix e, Monad m) + => (a -> e -> m a) + -> a + -> Array r ix e + -> m () sfoldlM_ f acc = void . sfoldlM f acc {-# INLINE sfoldlM_ #-} @@ -2316,7 +2464,11 @@ sfoldlM_ f acc = void . sfoldlM f acc -- ==== __Examples__ -- -- @since 0.5.0 -sfoldl1' :: (HasCallStack, Stream r ix e) => (e -> e -> e) -> Array r ix e -> e +sfoldl1' :: + forall r ix e. (HasCallStack, Stream r ix e) + => (e -> e -> e) + -> Array r ix e + -> e sfoldl1' f = throwEither . sfoldl1M (\e -> pure . f e) {-# INLINE sfoldl1' #-} @@ -2325,7 +2477,11 @@ sfoldl1' f = throwEither . sfoldl1M (\e -> pure . f e) -- ==== __Examples__ -- -- @since 0.5.0 -sfoldl1M :: (Stream r ix e, MonadThrow m) => (e -> e -> m e) -> Array r ix e -> m e +sfoldl1M :: + forall r ix e m. (Stream r ix e, MonadThrow m) + => (e -> e -> m e) + -> Array r ix e + -> m e sfoldl1M f arr = do let str = S.transStepsId $ toStream arr isNullStream <- S.null str @@ -2338,7 +2494,11 @@ sfoldl1M f arr = do -- ==== __Examples__ -- -- @since 0.5.0 -sfoldl1M_ :: (Stream r ix e, MonadThrow m) => (e -> e -> m e) -> Array r ix e -> m () +sfoldl1M_ :: + forall r ix e m. (Stream r ix e, MonadThrow m) + => (e -> e -> m e) + -> Array r ix e + -> m () sfoldl1M_ f = void . sfoldl1M f {-# INLINE sfoldl1M_ #-} @@ -2349,7 +2509,12 @@ sfoldl1M_ f = void . sfoldl1M f -- ==== __Examples__ -- -- @since 0.5.0 -sifoldl :: Stream r ix e => (a -> ix -> e -> a) -> a -> Array r ix e -> a +sifoldl :: + forall r ix e a. Stream r ix e + => (a -> ix -> e -> a) + -> a + -> Array r ix e + -> a sifoldl f acc = S.unId . S.foldl (\a (ix, e) -> f a ix e) acc . toStreamIx {-# INLINE sifoldl #-} @@ -2358,7 +2523,12 @@ sifoldl f acc = S.unId . S.foldl (\a (ix, e) -> f a ix e) acc . toStreamIx -- ==== __Examples__ -- -- @since 0.5.0 -sifoldlM :: (Stream r ix e, Monad m) => (a -> ix -> e -> m a) -> a -> Array r ix e -> m a +sifoldlM :: + forall r ix e a m. (Stream r ix e, Monad m) + => (a -> ix -> e -> m a) + -> a + -> Array r ix e + -> m a sifoldlM f acc = S.foldlM (\a (ix, e) -> f a ix e) acc . S.transStepsId . toStreamIx {-# INLINE sifoldlM #-} @@ -2367,7 +2537,12 @@ sifoldlM f acc = S.foldlM (\a (ix, e) -> f a ix e) acc . S.transStepsId . toStre -- ==== __Examples__ -- -- @since 0.5.0 -sifoldlM_ :: (Stream r ix e, Monad m) => (a -> ix -> e -> m a) -> a -> Array r ix e -> m () +sifoldlM_ :: + forall r ix e a m. (Stream r ix e, Monad m) + => (a -> ix -> e -> m a) + -> a + -> Array r ix e + -> m () sifoldlM_ f acc = void . sifoldlM f acc {-# INLINE sifoldlM_ #-} @@ -2377,7 +2552,10 @@ sifoldlM_ f acc = void . sifoldlM f acc -- ==== __Examples__ -- -- @since 0.5.0 -sor :: Stream r ix Bool => Array r ix Bool -> Bool +sor :: + forall r ix. Stream r ix Bool + => Array r ix Bool + -> Bool sor = S.unId . S.or . toStream {-# INLINE sor #-} @@ -2387,7 +2565,7 @@ sor = S.unId . S.or . toStream -- ==== __Examples__ -- -- @since 0.5.0 -sand :: Stream r ix Bool => Array r ix Bool -> Bool +sand :: forall r ix. Stream r ix Bool => Array r ix Bool -> Bool sand = S.unId . S.and . toStream {-# INLINE sand #-} @@ -2397,7 +2575,7 @@ sand = S.unId . S.and . toStream -- ==== __Examples__ -- -- @since 0.5.0 -sany :: Stream r ix e => (e -> Bool) -> Array r ix e -> Bool +sany :: forall r ix e. Stream r ix e => (e -> Bool) -> Array r ix e -> Bool sany f = S.unId . S.or . S.map f . toStream {-# INLINE sany #-} @@ -2407,7 +2585,7 @@ sany f = S.unId . S.or . S.map f . toStream -- ==== __Examples__ -- -- @since 0.5.0 -sall :: Stream r ix e => (e -> Bool) -> Array r ix e -> Bool +sall :: forall r ix e. Stream r ix e => (e -> Bool) -> Array r ix e -> Bool sall f = S.unId . S.and . S.map f . toStream {-# INLINE sall #-} @@ -2424,7 +2602,7 @@ sall f = S.unId . S.and . S.map f . toStream -- 88 -- -- @since 0.5.0 -ssum :: (Num e, Stream r ix e) => Array r ix e -> e +ssum :: forall r ix e. (Num e, Stream r ix e) => Array r ix e -> e ssum = sfoldl (+) 0 {-# INLINE ssum #-} @@ -2439,7 +2617,7 @@ ssum = sfoldl (+) 0 -- 10500 -- -- @since 0.5.0 -sproduct :: (Num e, Stream r ix e) => Array r ix e -> e +sproduct :: forall r ix e. (Num e, Stream r ix e) => Array r ix e -> e sproduct = sfoldl (*) 1 {-# INLINE sproduct #-} @@ -2455,7 +2633,7 @@ sproduct = sfoldl (*) 1 -- 70 -- -- @since 0.5.0 -smaximum' :: (HasCallStack, Ord e, Stream r ix e) => Array r ix e -> e +smaximum' :: forall r ix e. (HasCallStack, Ord e, Stream r ix e) => Array r ix e -> e smaximum' = sfoldl1' max {-# INLINE smaximum' #-} @@ -2474,7 +2652,7 @@ smaximum' = sfoldl1' max -- Nothing -- -- @since 0.5.0 -smaximumM :: (Ord e, Stream r ix e, MonadThrow m) => Array r ix e -> m e +smaximumM :: forall r ix e m. (Ord e, Stream r ix e, MonadThrow m) => Array r ix e -> m e smaximumM = sfoldl1M (\e acc -> pure (max e acc)) {-# INLINE smaximumM #-} @@ -2490,7 +2668,7 @@ smaximumM = sfoldl1M (\e acc -> pure (max e acc)) -- 3 -- -- @since 0.5.0 -sminimum' :: (HasCallStack, Ord e, Stream r ix e) => Array r ix e -> e +sminimum' :: forall r ix e. (HasCallStack, Ord e, Stream r ix e) => Array r ix e -> e sminimum' = sfoldl1' min {-# INLINE sminimum' #-} @@ -2509,6 +2687,6 @@ sminimum' = sfoldl1' min -- Nothing -- -- @since 0.5.0 -sminimumM :: (Ord e, Stream r ix e, MonadThrow m) => Array r ix e -> m e +sminimumM :: forall r ix e m. (Ord e, Stream r ix e, MonadThrow m) => Array r ix e -> m e sminimumM = sfoldl1M (\e acc -> pure (min e acc)) {-# INLINE sminimumM #-} diff --git a/massiv/src/Data/Massiv/Vector/Stream.hs b/massiv/src/Data/Massiv/Vector/Stream.hs index afd324ac..01e73c9c 100644 --- a/massiv/src/Data/Massiv/Vector/Stream.hs +++ b/massiv/src/Data/Massiv/Vector/Stream.hs @@ -358,16 +358,16 @@ length (Steps str sz) = null :: Monad m => Steps m a -> m Bool null (Steps str sz) = case sz of - LengthExact k -> pure (k == 0) + LengthExact k -> pure (k == zeroSz) _ -> S.null str {-# INLINE null #-} empty :: Monad m => Steps m e -empty = Steps S.empty (LengthExact 0) +empty = Steps S.empty (LengthExact zeroSz) {-# INLINE empty #-} singleton :: Monad m => e -> Steps m e -singleton e = Steps (S.singleton e) (LengthExact 1) +singleton e = Steps (S.singleton e) (LengthExact oneSz) {-# INLINE singleton #-} generate :: Monad m => Sz1 -> (Int -> e) -> Steps m e @@ -394,7 +394,7 @@ cons e (Steps str k) = Steps (S.cons e str) (k `addInt` 1) -- | First element of the `Steps` or `Nothing` if empty uncons :: Monad m => Steps m e -> m (Maybe (e, Steps m e)) -uncons sts = (\mx -> (, drop 1 sts) <$> mx) <$> headMaybe sts +uncons sts = (\mx -> (, drop oneSz sts) <$> mx) <$> headMaybe sts {-# INLINE uncons #-} snoc :: Monad m => Steps m e -> e -> Steps m e @@ -775,7 +775,7 @@ unfoldrExactN n f = unfoldrExactNM n (pure . f) {-# INLINE unfoldrExactN #-} unfoldrExactNM :: Monad m => Sz1 -> (s -> m (a, s)) -> s -> Steps m a -unfoldrExactNM n f t = Steps (S.Stream step (t, n)) (LengthExact n) +unfoldrExactNM n f t = Steps (S.Stream step (t, unSz n)) (LengthExact n) where step (s, i) | i <= 0 = pure S.Done diff --git a/massiv/src/Data/Massiv/Vector/Unsafe.hs b/massiv/src/Data/Massiv/Vector/Unsafe.hs index 89068d7e..afbe99e6 100644 --- a/massiv/src/Data/Massiv/Vector/Unsafe.hs +++ b/massiv/src/Data/Massiv/Vector/Unsafe.hs @@ -111,7 +111,7 @@ unsafeInit v = unsafeLinearSlice 0 (SafeSz (coerce (size v) - 1)) v -- -- @since 0.5.0 unsafeTail :: Source r e => Vector r e -> Vector r e -unsafeTail = unsafeDrop 1 +unsafeTail = unsafeDrop oneSz {-# INLINE unsafeTail #-} diff --git a/shell.nix b/shell.nix index 3907cbe3..86c94892 100644 --- a/shell.nix +++ b/shell.nix @@ -13,6 +13,6 @@ let }; in pkgs.mkShell { - buildInputs = [ stack pkgs.haskellPackages.ghcid pkgs.haskell.compiler.ghc8104 pkgs.gmp ]; + buildInputs = [ stack pkgs.haskellPackages.ghcid pkgs.haskell.compiler.ghc901 pkgs.gmp ]; } diff --git a/stack.yaml b/stack.yaml index 5768aafe..788a5db8 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-18.0 +resolver: nightly-2021-06-19 packages: - 'massiv/' - 'massiv-test/' From 487e2f1b8ed617c1b038c7d415924b3b117777f1 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sun, 20 Jun 2021 11:47:55 +0300 Subject: [PATCH 31/65] Fix tests failures --- massiv-test/src/Test/Massiv/Core/Index.hs | 122 +++++++++--------- .../tests/Test/Massiv/Core/IndexSpec.hs | 4 - massiv/src/Data/Massiv/Vector.hs | 2 +- 3 files changed, 65 insertions(+), 63 deletions(-) diff --git a/massiv-test/src/Test/Massiv/Core/Index.hs b/massiv-test/src/Test/Massiv/Core/Index.hs index 1374fa39..5f4cfa4c 100644 --- a/massiv-test/src/Test/Massiv/Core/Index.hs +++ b/massiv-test/src/Test/Massiv/Core/Index.hs @@ -41,6 +41,7 @@ import Data.Massiv.Array.Unsafe (Sz(SafeSz)) import Data.Massiv.Core.Index import Data.Proxy import Data.Typeable +import GHC.Exception (ErrorCall(ErrorCallWithLocation)) import Test.Massiv.Utils @@ -419,52 +420,53 @@ ixSpec :: ixSpec = do let threshold = 50000 describe "Safety" $ do - it "IsSafeIndex" $ property $ prop_IsSafeIndex @ix - it "RepairSafeIx" $ property $ prop_RepairSafeIx @ix + prop "IsSafeIndex" $ prop_IsSafeIndex @ix + prop "RepairSafeIx" $ prop_RepairSafeIx @ix describe "Lifting" $ - it "Lift/Lift2" $ property $ prop_LiftLift2 @ix + prop "Lift/Lift2" $ prop_LiftLift2 @ix describe "Linear" $ do - it "ToFromLinearIndex" $ property $ prop_ToFromLinearIndex @ix - it "FromToLinearIndex" $ property $ prop_FromToLinearIndex @ix + prop "ToFromLinearIndex" $ prop_ToFromLinearIndex @ix + prop "FromToLinearIndex" $ prop_FromToLinearIndex @ix describe "Iterator" $ do - it "CountElements" $ property $ prop_CountElements @ix threshold - it "Monotonic" $ property $ prop_IterMonotonic @ix threshold - it "MonotonicBackwards" $ property $ prop_IterMonotonicBackwards @ix threshold - it "MonotonicM" $ property $ prop_IterMonotonicM @ix threshold - it "MonotonicBackwardsM" $ property $ prop_IterMonotonicBackwardsM @ix threshold + prop "CountElements" $ prop_CountElements @ix threshold + prop "Monotonic" $ prop_IterMonotonic @ix threshold + prop "MonotonicBackwards" $ prop_IterMonotonicBackwards @ix threshold + prop "MonotonicM" $ prop_IterMonotonicM @ix threshold + prop "MonotonicBackwardsM" $ prop_IterMonotonicBackwardsM @ix threshold describe "Border" $ - it "BorderRepairSafe" $ property $ prop_BorderRepairSafe @ix + prop "BorderRepairSafe" $ prop_BorderRepairSafe @ix describe "SetGetDrop" $ do - it "SetAll" $ property $ prop_SetAll @ix - it "SetGet" $ property $ prop_SetGet @ix - it "GetDropInsert" $ property $ prop_GetDropInsert @ix - it "PullOutInsert" $ property $ prop_PullOutInsert @ix - it "UnconsCons" $ property $ prop_UnconsCons @ix - it "UnsnocSnoc" $ property $ prop_UnsnocSnoc @ix + prop "SetAll" $ prop_SetAll @ix + prop "SetGet" $ prop_SetGet @ix + prop "GetDropInsert" $ prop_GetDropInsert @ix + prop "PullOutInsert" $ prop_PullOutInsert @ix + prop "UnconsCons" $ prop_UnconsCons @ix + prop "UnsnocSnoc" $ prop_UnsnocSnoc @ix describe "IndexDimensionException" $ do - it "getDimException" $ property $ prop_getDimException @ix - it "setDimException" $ property $ prop_setDimException @ix - it "PullOutDimException" $ property $ prop_PullOutDimException @ix - it "InsertDimException" $ property $ prop_InsertDimException @ix + prop "getDimException" $ prop_getDimException @ix + prop "setDimException" $ prop_setDimException @ix + prop "PullOutDimException" $ prop_PullOutDimException @ix + prop "InsertDimException" $ prop_InsertDimException @ix describe "Dimension" $ do - it "GetInnerDimension" $ property $ \(ix :: ix) -> lastDim ix === getDimension ix Dim1 - it "GetOuterDimension" $ property $ + prop "GetInnerDimension" $ \(ix :: ix) -> lastDim ix === getDimension ix Dim1 + prop "GetOuterDimension" $ \(ix :: ix) -> headDim ix === getDimension ix (DimN :: Dimension (Dimensions ix)) - it "SetInnerDimension" $ property $ + prop "SetInnerDimension" $ \(ix :: ix) i -> snocDim (initDim ix) i === setDimension ix Dim1 i - it "SetOuterDimension" $ property $ - \(ix :: ix) i -> consDim i (tailDim ix) === setDimension ix (DimN :: Dimension (Dimensions ix)) i - it "DropInnerDimension" $ property $ \(ix :: ix) -> initDim ix === dropDimension ix Dim1 - it "DropOuterDimension" $ property $ + prop "SetOuterDimension" $ + \(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)) - it "InsertInnerDimension" $ property $ + prop "InsertInnerDimension" $ \(ixl :: Lower ix) i -> (snocDim ixl i :: ix) === insertDimension ixl Dim1 i - it "InsertOuterDimension" $ property $ + prop "InsertOuterDimension" $ \(ixl :: Lower ix) i -> (consDim i ixl :: ix) === insertDimension ixl (DimN :: Dimension (Dimensions ix)) i - it "PullOutInnerDimension" $ property $ + prop "PullOutInnerDimension" $ \(ix :: ix) -> unsnocDim ix === uncurry (flip (,)) (pullOutDimension ix Dim1) - it "PullInnerOuterDimension" $ property $ + prop "PullInnerOuterDimension" $ \(ix :: ix) -> unconsDim ix === pullOutDimension ix (DimN :: Dimension (Dimensions ix)) @@ -479,21 +481,21 @@ ix2UpSpec :: => Spec ix2UpSpec = describe "Higher/Lower" $ do - it "UnconsGetDrop" $ property $ prop_UnconsGetDrop @ix - it "UnsnocGetDrop" $ property $ prop_UnsnocGetDrop @ix + 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 = do describe ("Num (" ++ showsType @ix ")") $ do - it "(+)" $ property $ prop_BinaryNumIx @ix (+) - it "(-)" $ property $ prop_BinaryNumIx @ix (-) - it "(*)" $ property $ prop_BinaryNumIx @ix (*) - it "negate" $ property $ prop_UnaryNumIx @ix negate - it "abs" $ property $ prop_UnaryNumIx @ix abs - it "signum" $ property $ prop_UnaryNumIx @ix signum - it "fromInteger" $ property $ \ (i :: Int) -> + prop "(+)" $ prop_BinaryNumIx @ix (+) + prop "(-)" $ prop_BinaryNumIx @ix (-) + prop "(*)" $ prop_BinaryNumIx @ix (*) + prop "negate" $ prop_UnaryNumIx @ix negate + prop "abs" $ prop_UnaryNumIx @ix abs + prop "signum" $ prop_UnaryNumIx @ix signum + prop "fromInteger" $ \ (i :: Int) -> (fromIntegral i :: ix) === liftIndex (const i) zeroIndex describe "Constants" $ do it "zeroIndex" $ (zeroIndex :: ix) `shouldBe` 0 @@ -503,15 +505,19 @@ ixNumSpec = do szNumSpec :: forall ix . (Typeable ix, Num ix, Index ix, Arbitrary ix) => Spec szNumSpec = do describe ("Num (" ++ showsType @(Sz ix) ")") $ do - it "(+)" $ property $ prop_BinaryNumSz @ix (+) - it "(-)" $ property $ prop_BinaryNumSz @ix (-) - it "(*)" $ property $ prop_BinaryNumSz @ix (*) - it "negate" $ property $ prop_UnaryNumSz @ix negate - it "abs" $ property $ prop_UnaryNumSz @ix abs - it "signum" $ property $ prop_UnaryNumSz @ix signum - it "fromInteger" $ property $ \ (i :: Int) -> + 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) + + prop "abs" $ prop_UnaryNumSz @ix abs + prop "signum" $ prop_UnaryNumSz @ix signum + prop "fromInteger" $ \ (i :: Int) -> (fromIntegral i :: Sz ix) === SafeSz (pureIndex (max 0 i)) - it "fromIx" $ property $ \ (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 @@ -529,17 +535,17 @@ szSpec :: => Spec szSpec = do describe "Higher/Lower" $ do - it "LiftSzNegate" $ property $ \ (sz :: Sz ix) -> liftSz negate sz === zeroSz - it "UnconsCons" $ property $ \ (sz :: Sz ix) -> sz === uncurry consSz (unconsSz sz) - it "UnsnocSnoc" $ property $ \ (sz :: Sz ix) -> sz === uncurry snocSz (unsnocSz sz) - it "PullOutInsert" $ property $ prop_PullOutInsertSize @ix - it "SetSzInnerSnoc" $ property $ + 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 describe "Number of Elements" $ do - it "TotalElem" $ property $ + prop "TotalElem" $ \(sz :: Sz ix) -> totalElem sz === foldlIndex (*) 1 (unSz sz) - it "IsNonZeroSz" $ property $ + prop "IsNonZeroSz" $ \(sz :: Sz ix) -> isNotZeroSz sz === foldlIndex (\a x -> a && x > 0) True (unSz sz) describe "Iterators" $ do - it "IterLinearM" $ property $ prop_IterLinearM @ix - it "IterLinearM_" $ property $ prop_IterLinearM_ @ix + prop "IterLinearM" $ prop_IterLinearM @ix + prop "IterLinearM_" $ prop_IterLinearM_ @ix diff --git a/massiv-test/tests/Test/Massiv/Core/IndexSpec.hs b/massiv-test/tests/Test/Massiv/Core/IndexSpec.hs index 780759be..02e69058 100644 --- a/massiv-test/tests/Test/Massiv/Core/IndexSpec.hs +++ b/massiv-test/tests/Test/Massiv/Core/IndexSpec.hs @@ -1,7 +1,6 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} @@ -142,9 +141,6 @@ specSz = do describe ("Sz (" ++ showsTypeRep (typeRep (Proxy :: Proxy ix)) ")") $ do szSpec @ix szNumSpec @ix - prop "throws error on negate" $ \sz -> - sz /= zeroSz ==> - assertException (\(ErrorCallWithLocation err loc) -> err `deepseq` loc `deepseq` True) (negate sz) prop "Show" $ \sz -> ("Just (" ++ show (sz :: Sz ix) ++ ")") === show (Just sz) eqSpecOnArbitrary @(Sz ix) ordSpecOnArbitrary @(Sz ix) diff --git a/massiv/src/Data/Massiv/Vector.hs b/massiv/src/Data/Massiv/Vector.hs index 8deeb204..5263e507 100644 --- a/massiv/src/Data/Massiv/Vector.hs +++ b/massiv/src/Data/Massiv/Vector.hs @@ -798,7 +798,7 @@ tailM v = do -- >>> A.take 5 (0 ..: 10) -- Array D Seq (Sz1 5) -- [ 0, 1, 2, 3, 4 ] --- >>> A.take (-5) (0 ..: 10) +-- >>> A.take 0 (0 ..: 10) -- Array D Seq (Sz1 0) -- [ ] -- >>> A.take 100 (0 ..: 10) From 4f7d3345735492b22e6256a9963f9a50ddc9d1cd Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sun, 20 Jun 2021 17:41:55 +0300 Subject: [PATCH 32/65] Remove helper class `Nested` and type family `NestedStuct` --- .../Test/Massiv/Array/Ops/ConstructSpec.hs | 2 +- massiv/CHANGELOG.md | 1 + .../src/Data/Massiv/Array/Manifest/Boxed.hs | 22 +------ massiv/src/Data/Massiv/Array/Manifest/List.hs | 50 +++++++++------- .../Data/Massiv/Array/Manifest/Primitive.hs | 8 +-- .../Data/Massiv/Array/Manifest/Storable.hs | 8 +-- .../src/Data/Massiv/Array/Manifest/Unboxed.hs | 8 +-- massiv/src/Data/Massiv/Core.hs | 2 - massiv/src/Data/Massiv/Core/Common.hs | 15 +---- massiv/src/Data/Massiv/Core/List.hs | 57 +++++-------------- 10 files changed, 54 insertions(+), 119 deletions(-) diff --git a/massiv-test/tests/Test/Massiv/Array/Ops/ConstructSpec.hs b/massiv-test/tests/Test/Massiv/Array/Ops/ConstructSpec.hs index 2517b298..b370aa88 100644 --- a/massiv-test/tests/Test/Massiv/Array/Ops/ConstructSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/Ops/ConstructSpec.hs @@ -36,7 +36,7 @@ prop_toFromListIsList _ (ArrNE arr) = arr === GHC.fromList (GHC.toList arr) prop_toFromList :: - forall ix . (Show (Array U ix Int), Nested LN ix Int, Ragged L ix Int) + forall ix . (Show (Array U ix Int), Ragged L ix Int) => Proxy ix -> ArrNE U ix Int -> Property diff --git a/massiv/CHANGELOG.md b/massiv/CHANGELOG.md index 61230e2e..79986b50 100644 --- a/massiv/CHANGELOG.md +++ b/massiv/CHANGELOG.md @@ -1,5 +1,6 @@ # 1.0.0 +* Remove helper class `Nested` and type family `NestedStuct` * Make `negate` in `Num` instance throw error for `Sz` in order to avoid surprising behavior reported in: [#114](https://github.com/lehins/massiv/issues/114) * Add of `munsafeResize` diff --git a/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs b/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs index 21f3775e..7e353267 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs @@ -255,12 +255,7 @@ instance Index ix => Traversable (Array BL ix) where traverse = traverseA {-# INLINE traverse #-} -instance ( IsList (Array L ix e) - , Nested LN ix e - , Nested L ix e - , Ragged L ix e - ) => - IsList (Array BL ix e) where +instance (IsList (Array L ix e), Ragged L ix e) => IsList (Array BL ix e) where type Item (Array BL ix e) = Item (Array L ix e) fromList = L.fromLists' Seq {-# INLINE fromList #-} @@ -426,12 +421,7 @@ instance Index ix => Traversable (Array B ix) where traverse = traverseA {-# INLINE traverse #-} -instance ( IsList (Array L ix e) - , Nested LN ix e - , Nested L ix e - , Ragged L ix e - ) => - IsList (Array B ix e) where +instance (IsList (Array L ix e), Ragged L ix e) => IsList (Array B ix e) where type Item (Array B ix e) = Item (Array L ix e) fromList = L.fromLists' Seq {-# INLINE fromList #-} @@ -566,13 +556,7 @@ instance (Index ix, NFData e) => Stream BN ix e where {-# INLINE toStreamIx #-} -instance ( NFData e - , IsList (Array L ix e) - , Nested LN ix e - , Nested L ix e - , Ragged L ix e - ) => - IsList (Array BN ix e) where +instance (NFData e, IsList (Array L ix e), Ragged L ix e) => IsList (Array BN ix e) where type Item (Array BN ix e) = Item (Array L ix e) fromList = L.fromLists' Seq {-# INLINE fromList #-} diff --git a/massiv/src/Data/Massiv/Array/Manifest/List.hs b/massiv/src/Data/Massiv/Array/Manifest/List.hs index b1d2bf2a..dedfdb0d 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/List.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/List.hs @@ -29,7 +29,7 @@ import Data.Massiv.Array.Ops.Fold (foldrInner) import Data.Massiv.Array.Ops.Fold.Internal (foldrFB) import Data.Massiv.Core.Common import Data.Massiv.Core.List -import GHC.Exts (build) +import qualified GHC.Exts as GHC (build, IsList(..)) -- | Convert a flat list into a vector -- @@ -80,14 +80,23 @@ fromList = fromLists' -- *** Exception: DimTooShortException: expected (Sz1 3), got (Sz1 2) -- -- @since 0.3.0 -fromListsM :: forall r ix e m . (Nested LN ix e, Ragged L ix e, Mutable r e, MonadThrow m) - => Comp -> [ListItem ix e] -> m (Array r ix e) -fromListsM comp = fromRaggedArrayM . setComp comp . throughNested +fromListsM :: + forall r ix e m. (Ragged L ix e, Mutable r e, MonadThrow m) + => Comp + -> [ListItem ix e] + -> m (Array r ix e) +fromListsM comp = fromRaggedArrayM . setComp comp . fromListToListArray {-# INLINE fromListsM #-} --- TODO: Figure out QuickCheck properties. Best guess idea so far IMHO is to add it as dependency --- and move Arbitrary instances int the library --- + +fromListToListArray :: + forall ix e. GHC.IsList (Array L ix e) + => [ListItem ix e] + -> Array L ix e +fromListToListArray = GHC.fromList +{-# INLINE fromListToListArray #-} + + -- | Same as `fromListsM`, but will throw an error on irregular shaped lists. -- -- __Note__: This function is the same as if you would turn on @{-\# LANGUAGE OverloadedLists #-}@ @@ -116,19 +125,15 @@ fromListsM comp = fromRaggedArrayM . setComp comp . throughNested -- ] -- -- @since 0.1.0 -fromLists' :: forall r ix e . (HasCallStack, Nested LN ix e, Ragged L ix e, Mutable r e) - => Comp -- ^ Computation startegy to use - -> [ListItem ix e] -- ^ Nested list - -> Array r ix e -fromLists' comp = fromRaggedArray' . setComp comp . throughNested +fromLists' :: + forall r ix e. (HasCallStack, Ragged L ix e, Mutable r e) + => Comp -- ^ Computation startegy to use + -> [ListItem ix e] -- ^ Nested list + -> Array r ix e +fromLists' comp = fromRaggedArray' . setComp comp . fromListToListArray {-# INLINE fromLists' #-} -throughNested :: forall ix e . Nested LN ix e => [ListItem ix e] -> Array L ix e -throughNested xs = fromNested (fromNested xs :: Array LN ix e) -{-# INLINE throughNested #-} - - -- | Convert any array to a flat list. -- @@ -140,7 +145,7 @@ throughNested xs = fromNested (fromNested xs :: Array LN ix e) -- -- @since 0.1.0 toList :: (Index ix, Source r e) => Array r ix e -> [e] -toList !arr = build (\ c n -> foldrFB c n arr) +toList !arr = GHC.build (\ c n -> foldrFB c n arr) {-# INLINE toList #-} @@ -165,10 +170,11 @@ toList !arr = build (\ c n -> foldrFB c n arr) -- [[[0 :> 0 :. 0,0 :> 0 :. 1,0 :> 0 :. 2]],[[1 :> 0 :. 0,1 :> 0 :. 1,1 :> 0 :. 2]]] -- -- @since 0.1.0 -toLists :: (Nested LN ix e, Ragged L ix e, Load r ix e, Source r e) - => Array r ix e - -> [ListItem ix e] -toLists = toNested . toNested . toListArray +toLists :: + (Ragged L ix e, Load r ix e, Source r e) + => Array r ix e -- ^ Array to be converted to nested lists + -> [ListItem ix e] +toLists = GHC.toList . toListArray {-# INLINE toLists #-} diff --git a/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs b/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs index 19653d90..dbec9125 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs @@ -241,13 +241,7 @@ instance (Prim e, Num e) => Numeric P e where instance (Prim e, Floating e) => NumericFloat P e -instance ( Prim e - , IsList (Array L ix e) - , Nested LN ix e - , Nested L ix e - , Ragged L ix e - ) => - IsList (Array P ix e) where +instance (Prim e, IsList (Array L ix e), Ragged L ix e) => IsList (Array P ix e) where type Item (Array P ix e) = Item (Array L ix e) fromList = A.fromLists' Seq {-# INLINE fromList #-} diff --git a/massiv/src/Data/Massiv/Array/Manifest/Storable.hs b/massiv/src/Data/Massiv/Array/Manifest/Storable.hs index 391c0152..609e21a5 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Storable.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Storable.hs @@ -232,13 +232,7 @@ instance (Storable e, Num e) => Numeric S e where instance (Storable e, Floating e) => NumericFloat S e -instance ( Storable e - , IsList (Array L ix e) - , Nested LN ix e - , Nested L ix e - , Ragged L ix e - ) => - IsList (Array S ix e) where +instance (Storable e, IsList (Array L ix e), Ragged L ix e) => IsList (Array S ix e) where type Item (Array S ix e) = Item (Array L ix e) fromList = A.fromLists' Seq {-# INLINE fromList #-} diff --git a/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs b/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs index f1a0d9fa..7c511edd 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs @@ -167,13 +167,7 @@ instance (Index ix, Unbox e) => Stream U ix e where {-# INLINE toStreamIx #-} -instance ( Unbox e - , IsList (Array L ix e) - , Nested LN ix e - , Nested L ix e - , Ragged L ix e - ) => - IsList (Array U ix e) where +instance (Unbox e, IsList (Array L ix e), Ragged L ix e) => IsList (Array U ix e) where type Item (Array U ix e) = Item (Array L ix e) fromList = A.fromLists' Seq {-# INLINE fromList #-} diff --git a/massiv/src/Data/Massiv/Core.hs b/massiv/src/Data/Massiv/Core.hs index 7b00d49e..04c8a38f 100644 --- a/massiv/src/Data/Massiv/Core.hs +++ b/massiv/src/Data/Massiv/Core.hs @@ -23,8 +23,6 @@ module Data.Massiv.Core , Manifest , Mutable , Ragged - , Nested(..) - , NestedStruct , L(..) , LN , ListItem diff --git a/massiv/src/Data/Massiv/Core/Common.hs b/massiv/src/Data/Massiv/Core/Common.hs index 7735cac1..32265e96 100644 --- a/massiv/src/Data/Massiv/Core/Common.hs +++ b/massiv/src/Data/Massiv/Core/Common.hs @@ -47,8 +47,6 @@ module Data.Massiv.Core.Common , unsafeLinearSwap , unsafeDefaultLinearShrink , Ragged(..) - , Nested(..) - , NestedStruct , empty , singleton -- * Size @@ -103,6 +101,7 @@ import Control.Scheduler (Comp(..), Scheduler, WorkerStates, numWorkers, scheduleWork, scheduleWork_, trivialScheduler_, withScheduler_) import Control.Scheduler.Global +import GHC.Exts (IsList) import Data.Massiv.Core.Exception import Data.Massiv.Core.Index import Data.Massiv.Core.Index.Internal (Sz(SafeSz)) @@ -148,9 +147,6 @@ type family Elt r ix e :: Type where Elt r Ix1 e = e Elt r ix e = Array r (Lower ix) e -type family NestedStruct r ix e :: Type - - class Load r ix e => Stream r ix e where toStream :: Array r ix e -> Steps Id e @@ -495,7 +491,7 @@ class (Resize r, Source r e) => Manifest r e where unsafeLinearIndexM :: Index ix => Array r ix e -> Int -> e -class (Manifest r e) => Mutable r e where +class Manifest r e => Mutable r e where data MArray s r ix e :: Type -- | Get the size of a mutable array. @@ -695,12 +691,7 @@ unsafeLinearSwap !marr !i1 !i2 = do {-# INLINE unsafeLinearSwap #-} -class Nested r ix e where - fromNested :: NestedStruct r ix e -> Array r ix e - - toNested :: Array r ix e -> NestedStruct r ix e - -class Load r ix e => Ragged r ix e where +class (IsList (Array r ix e), Load r ix e) => Ragged r ix e where emptyR :: Comp -> Array r ix e diff --git a/massiv/src/Data/Massiv/Core/List.hs b/massiv/src/Data/Massiv/Core/List.hs index 051db97e..87598ab9 100644 --- a/massiv/src/Data/Massiv/Core/List.hs +++ b/massiv/src/Data/Massiv/Core/List.hs @@ -50,8 +50,6 @@ type family ListItem ix e :: Type where ListItem Ix1 e = e ListItem ix e = [ListItem (Lower ix) e] -type instance NestedStruct LN ix e = [ListItem ix e] - newtype instance Array LN ix e = List { unList :: [Elt LN ix e] } --TODO remove @@ -60,52 +58,26 @@ instance Strategy LN where setComp _ = id -instance {-# OVERLAPPING #-} Nested LN Ix1 e where - fromNested = coerce - {-# INLINE fromNested #-} - toNested = coerce - {-# INLINE toNested #-} - -instance ( Elt LN ix e ~ Array LN (Lower ix) e - , ListItem ix e ~ [ListItem (Lower ix) e] - , Coercible (Elt LN ix e) (ListItem ix e) - ) => - Nested LN ix e where - fromNested = coerce - {-# INLINE fromNested #-} - toNested = coerce - {-# INLINE toNested #-} - - -instance Nested LN ix e => IsList (Array LN ix e) where +instance Coercible (Elt LN ix e) (ListItem ix e) => IsList (Array LN ix e) where type Item (Array LN ix e) = ListItem ix e - fromList = fromNested + fromList = coerce {-# INLINE fromList #-} - toList = toNested + toList = coerce {-# INLINE toList #-} data L = L -type instance NestedStruct L ix e = Array LN ix e - data instance Array L ix e = LArray { lComp :: Comp , lData :: !(Array LN ix e) } -instance Nested L ix e where - fromNested = LArray Seq - {-# INLINE fromNested #-} - toNested = lData - {-# INLINE toNested #-} - - -instance Nested LN ix e => IsList (Array L ix e) where +instance Coercible (Elt LN ix e) (ListItem ix e) => IsList (Array L ix e) where type Item (Array L ix e) = ListItem ix e - fromList = LArray Seq . fromNested + fromList = LArray Seq . coerce {-# INLINE fromList #-} - toList = toNested . lData + toList = coerce . lData {-# INLINE toList #-} lengthHintList :: [a] -> LengthHint @@ -115,7 +87,6 @@ lengthHintList = _ -> LengthUnknown {-# INLINE lengthHintList #-} - instance Shape LN Ix1 where linearSize = SafeSz . length . unList {-# INLINE linearSize #-} @@ -266,7 +237,11 @@ instance Ragged L Ix2 e where showN (\s y -> raggedFormat f s (LArray comp y :: Array L Ix1 e)) sep (coerce xs) -instance (Shape L (IxN n), Shape LN (Ix (n - 1)), Ragged L (Ix (n - 1)) e) => +instance ( Shape L (IxN n) + , Shape LN (Ix (n - 1)) + , Ragged L (Ix (n - 1)) e + , Coercible (Elt LN (Ix (n - 1)) e) (ListItem (Ix (n - 1)) e) + ) => Ragged L (IxN n) e where emptyR comp = LArray comp (List []) {-# INLINE emptyR #-} @@ -358,10 +333,8 @@ instance Strategy L where -- | Construct an array backed by linked lists from any source array -- -- @since 0.4.0 -toListArray :: (Ragged L ix e, Load r ix e, Source r e) - => Array r ix e - -> Array L ix e -toListArray !arr = makeArray (getComp arr) (size arr) (unsafeIndex arr) +toListArray :: (Ragged L ix e, Shape r ix, Source r e) => Array r ix e -> Array L ix e +toListArray !arr = makeArray (getComp arr) (outerSize arr) (unsafeIndex arr) {-# INLINE toListArray #-} @@ -371,7 +344,7 @@ instance (Ragged L ix e, Show e) => Show (Array L ix e) where instance (Ragged L ix e, Show e) => Show (Array LN ix e) where show arr = " " ++ raggedFormat show "\n " arrL - where arrL = fromNested arr :: Array L ix e + where arrL = LArray Seq arr :: Array L ix e showN :: (String -> a -> String) -> String -> [a] -> String @@ -399,7 +372,7 @@ showsArrayLAsPrec pr n arr = if n == 0 then (id, id) else (('(':), ("\n)" ++)) - lnarr = toNested arr + lnarr = lData arr -- | Helper function for declaring `Show` instances for arrays -- From 2d88d86ab28b97c86f526abda7b109e1c3defe78 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Mon, 21 Jun 2021 01:22:31 +0300 Subject: [PATCH 33/65] Get rid of `Num` for delayed. Fix #97: * Addition of `sumArrays'`, `sumArraysM` and `productArrays'`, `productArraysM`. * Remove `Num`/`Fractional`/`Floating` instances for `D` and `DI` arrays. --- massiv/CHANGELOG.md | 5 +- .../Data/Massiv/Array/Delayed/Interleaved.hs | 2 +- massiv/src/Data/Massiv/Array/Delayed/Pull.hs | 85 +--------- massiv/src/Data/Massiv/Array/Numeric.hs | 146 ++++++++++++++++++ 4 files changed, 157 insertions(+), 81 deletions(-) diff --git a/massiv/CHANGELOG.md b/massiv/CHANGELOG.md index 79986b50..4643994b 100644 --- a/massiv/CHANGELOG.md +++ b/massiv/CHANGELOG.md @@ -1,5 +1,8 @@ # 1.0.0 +* Addition of `sumArrays'`, `sumArraysM` and `productArrays'`, `productArraysM`. +* Remove `Num`/`Fractional`/`Floating` instances for `D` and `DI` arrays. This was done to + prevent surprises as in: [#97](https://github.com/lehins/massiv/issues/97) * Remove helper class `Nested` and type family `NestedStuct` * Make `negate` in `Num` instance throw error for `Sz` in order to avoid surprising behavior reported in: [#114](https://github.com/lehins/massiv/issues/114) @@ -277,7 +280,7 @@ * `generateArrayS` * Redefined most of the numeric operators with `Numeric` and `NumericFloat`. Will be required for SIMD operations. -* `Num`, `Fractional` and `Applicative` for `D` changed behavior: instead of treating +* `Num`, `Fractional` and `Applicative` for `D` and `DI` changed behavior: instead of treating singleton as a special array of any size it is treated as singleton. # 0.3.6 diff --git a/massiv/src/Data/Massiv/Array/Delayed/Interleaved.hs b/massiv/src/Data/Massiv/Array/Delayed/Interleaved.hs index 42532eb8..22f84666 100644 --- a/massiv/src/Data/Massiv/Array/Delayed/Interleaved.hs +++ b/massiv/src/Data/Massiv/Array/Delayed/Interleaved.hs @@ -30,7 +30,7 @@ data DI = DI newtype instance Array DI ix e = DIArray { diArray :: Array D ix e - } deriving (Eq, Ord, Functor, Applicative, Foldable, Num, Floating, Fractional) + } deriving (Eq, Ord, Functor, Applicative, Foldable) instance (Ragged L ix e, Show e) => Show (Array DI ix e) where showsPrec = showsArrayPrec diArray diff --git a/massiv/src/Data/Massiv/Array/Delayed/Pull.hs b/massiv/src/Data/Massiv/Array/Delayed/Pull.hs index 80d9cb93..f9d75d69 100644 --- a/massiv/src/Data/Massiv/Array/Delayed/Pull.hs +++ b/massiv/src/Data/Massiv/Array/Delayed/Pull.hs @@ -171,59 +171,12 @@ instance Index ix => Stream D ix e where {-# INLINE toStreamIx #-} -- | Map an index aware function over an array -imap :: (Index ix, Source r e') => (ix -> e' -> e) -> Array r ix e' -> Array D ix e +-- +-- @since 0.1.0 +imap :: forall r ix e a. (Index ix, Source r e) => (ix -> e -> a) -> Array r ix e -> Array D ix a imap f !arr = DArray (getComp arr) (size arr) (\ !ix -> f ix (unsafeIndex arr ix)) {-# INLINE imap #-} -instance (Index ix, Num e) => Num (Array D ix e) where - (+) = liftArray2Matching (+) - {-# INLINE (+) #-} - (-) = liftArray2Matching (-) - {-# INLINE (-) #-} - (*) = liftArray2Matching (*) - {-# INLINE (*) #-} - abs = unsafeLiftArray abs - {-# INLINE abs #-} - signum = unsafeLiftArray signum - {-# INLINE signum #-} - fromInteger = singleton . fromInteger - {-# INLINE fromInteger #-} - -instance (Index ix, Fractional e) => Fractional (Array D ix e) where - (/) = liftArray2Matching (/) - {-# INLINE (/) #-} - fromRational = singleton . fromRational - {-# INLINE fromRational #-} - - -instance (Index ix, Floating e) => Floating (Array D ix e) where - pi = singleton pi - {-# INLINE pi #-} - exp = unsafeLiftArray exp - {-# INLINE exp #-} - log = unsafeLiftArray log - {-# INLINE log #-} - sin = unsafeLiftArray sin - {-# INLINE sin #-} - cos = unsafeLiftArray cos - {-# INLINE cos #-} - asin = unsafeLiftArray asin - {-# INLINE asin #-} - atan = unsafeLiftArray atan - {-# INLINE atan #-} - acos = unsafeLiftArray acos - {-# INLINE acos #-} - sinh = unsafeLiftArray sinh - {-# INLINE sinh #-} - cosh = unsafeLiftArray cosh - {-# INLINE cosh #-} - asinh = unsafeLiftArray asinh - {-# INLINE asinh #-} - atanh = unsafeLiftArray atanh - {-# INLINE atanh #-} - acosh = unsafeLiftArray acosh - {-# INLINE acosh #-} - instance Num e => FoldNumeric D e where unsafeDotProduct = defaultUnsafeDotProduct @@ -255,7 +208,7 @@ delay arr = DArray (getComp arr) (size arr) (unsafeIndex arr) "delay" [~1] forall (arr :: Array D ix e) . delay arr = arr #-} --- | /O(min (n1, n2))/ - Compute array equality by applying a comparing function to each element. +-- | Compute array equality by applying a comparing function to each element. -- -- @since 0.5.7 eqArrays :: (Index ix, Source r1 e1, Source r2 e2) => @@ -267,7 +220,7 @@ eqArrays f arr1 arr2 = f (unsafeIndex arr1 ix) (unsafeIndex arr2 ix))) {-# INLINE eqArrays #-} --- | /O(min (n1, n2))/ - Compute array ordering by applying a comparing function to each element. +-- | Compute array ordering by applying a comparing function to each element. -- The exact ordering is unspecified so this is only intended for use in maps and the like where -- you need an ordering but do not care about which one is used. -- @@ -283,7 +236,7 @@ compareArrays f arr1 arr2 = liftArray2Matching - :: (Index ix, Source r1 a, Source r2 b) + :: (HasCallStack, Index ix, Source r1 a, Source r2 b) => (a -> b -> e) -> Array r1 ix a -> Array r2 ix b -> Array D ix e liftArray2Matching f !arr1 !arr2 | sz1 == sz2 = @@ -297,29 +250,3 @@ liftArray2Matching f !arr1 !arr2 sz2 = size arr2 {-# INLINE liftArray2Matching #-} - --- -- | The usual map. --- liftArray :: Source r ix b => (b -> e) -> Array r ix b -> Array D ix e --- liftArray f !arr = DArray (getComp arr) (size arr) (f . unsafeIndex arr) --- {-# INLINE liftArray #-} - --- -- | Similar to `Data.Massiv.Array.zipWith`, except dimensions of both arrays either have to be the --- -- same, or at least one of the two array must be a singleton array, in which case it will behave as --- -- a `Data.Massiv.Array.map`. --- -- --- -- @since 0.1.4 --- liftArray2 --- :: (Source r1 ix a, Source r2 ix b) --- => (a -> b -> e) -> Array r1 ix a -> Array r2 ix b -> Array D ix e --- liftArray2 f !arr1 !arr2 --- | sz1 == oneSz = liftArray (f (unsafeIndex arr1 zeroIndex)) arr2 --- | sz2 == oneSz = liftArray (`f` unsafeIndex arr2 zeroIndex) arr1 --- | sz1 == sz2 = --- DArray (getComp arr1 <> getComp arr2) sz1 (\ !ix -> f (unsafeIndex arr1 ix) (unsafeIndex arr2 ix)) --- | otherwise = throw $ SizeMismatchException (size arr1) (size arr2) --- where --- sz1 = size arr1 --- sz2 = size arr2 --- {-# INLINE liftArray2 #-} - - diff --git a/massiv/src/Data/Massiv/Array/Numeric.hs b/massiv/src/Data/Massiv/Array/Numeric.hs index 332f533d..45633ca4 100644 --- a/massiv/src/Data/Massiv/Array/Numeric.hs +++ b/massiv/src/Data/Massiv/Array/Numeric.hs @@ -20,6 +20,8 @@ module Data.Massiv.Array.Numeric , (+.) , (.+.) , (!+!) + , sumArraysM + , sumArrays' -- ** Pointwise subtraction , (.-) , (-.) @@ -31,6 +33,8 @@ module Data.Massiv.Array.Numeric , (.*.) , (!*!) , (.^) + , productArraysM + , productArrays' -- ** Dot product , (!.!) , dotM @@ -1210,3 +1214,145 @@ atan2A :: -> m (Array r ix e) atan2A = liftArray2M atan2 {-# INLINE atan2A #-} + +-- | Same as `sumArraysM`, compute sum of arrays pointwise. All arrays must have the same +-- size, otherwise it will result in an error. +-- +-- @since 1.0.0 +sumArrays' :: (HasCallStack, Foldable t, Load r ix e, Numeric r e) => t (Array r ix e) -> Array r ix e +sumArrays' = throwEither . sumArraysM +{-# INLINE sumArrays' #-} + +-- | Compute sum of arrays pointwise. All arrays must have the same size. +-- +-- ====__Examples__ +-- +-- >>> import Data.Massiv.Array as A +-- >>> sumArraysM [] :: IO (Array P Ix3 Int) +-- Array P Seq (Sz (0 :> 0 :. 0)) +-- [ ] +-- >>> arr = A.makeArrayR P Seq (Sz3 4 5 6) $ \(i :> j :. k) -> i + j * k +-- >>> arr +-- Array P Seq (Sz (4 :> 5 :. 6)) +-- [ [ [ 0, 0, 0, 0, 0, 0 ] +-- , [ 0, 1, 2, 3, 4, 5 ] +-- , [ 0, 2, 4, 6, 8, 10 ] +-- , [ 0, 3, 6, 9, 12, 15 ] +-- , [ 0, 4, 8, 12, 16, 20 ] +-- ] +-- , [ [ 1, 1, 1, 1, 1, 1 ] +-- , [ 1, 2, 3, 4, 5, 6 ] +-- , [ 1, 3, 5, 7, 9, 11 ] +-- , [ 1, 4, 7, 10, 13, 16 ] +-- , [ 1, 5, 9, 13, 17, 21 ] +-- ] +-- , [ [ 2, 2, 2, 2, 2, 2 ] +-- , [ 2, 3, 4, 5, 6, 7 ] +-- , [ 2, 4, 6, 8, 10, 12 ] +-- , [ 2, 5, 8, 11, 14, 17 ] +-- , [ 2, 6, 10, 14, 18, 22 ] +-- ] +-- , [ [ 3, 3, 3, 3, 3, 3 ] +-- , [ 3, 4, 5, 6, 7, 8 ] +-- , [ 3, 5, 7, 9, 11, 13 ] +-- , [ 3, 6, 9, 12, 15, 18 ] +-- , [ 3, 7, 11, 15, 19, 23 ] +-- ] +-- ] +-- >>> sumArraysM $ outerSlices arr +-- Array P Seq (Sz (5 :. 6)) +-- [ [ 6, 6, 6, 6, 6, 6 ] +-- , [ 6, 10, 14, 18, 22, 26 ] +-- , [ 6, 14, 22, 30, 38, 46 ] +-- , [ 6, 18, 30, 42, 54, 66 ] +-- , [ 6, 22, 38, 54, 70, 86 ] +-- ] +-- >>> sumArraysM $ innerSlices arr +-- Array D Seq (Sz (4 :. 5)) +-- [ [ 0, 15, 30, 45, 60 ] +-- , [ 6, 21, 36, 51, 66 ] +-- , [ 12, 27, 42, 57, 72 ] +-- , [ 18, 33, 48, 63, 78 ] +-- ] +-- +-- @since 1.0.0 +sumArraysM :: + (Foldable t, Load r ix e, Numeric r e, MonadThrow m) => t (Array r ix e) -> m (Array r ix e) +sumArraysM as = + case F.toList as of + [] -> pure empty + (x:xs) -> F.foldlM (.+.) x xs +{-# INLINE sumArraysM #-} +-- OPTIMIZE: Allocate a single result array and write sums into it incrementally. + +-- | Same as `productArraysM`. Compute product of arrays pointwise. All arrays must have +-- the same size, otherwise it +-- will result in an error. +-- +-- @since 1.0.0 +productArrays' :: + (HasCallStack, Foldable t, Load r ix e, Numeric r e) => t (Array r ix e) -> Array r ix e +productArrays' = throwEither . productArraysM +{-# INLINE productArrays' #-} + + +-- | Compute product of arrays pointwise. All arrays must have the same size. +-- +-- ====__Examples__ +-- +-- >>> import Data.Massiv.Array as A +-- >>> productArraysM [] :: IO (Array P Ix3 Int) +-- Array P Seq (Sz (0 :> 0 :. 0)) +-- [ ] +-- >>> arr = A.makeArrayR P Seq (Sz3 4 5 6) $ \(i :> j :. k) -> i + j * k +-- >>> arr +-- Array P Seq (Sz (4 :> 5 :. 6)) +-- [ [ [ 0, 0, 0, 0, 0, 0 ] +-- , [ 0, 1, 2, 3, 4, 5 ] +-- , [ 0, 2, 4, 6, 8, 10 ] +-- , [ 0, 3, 6, 9, 12, 15 ] +-- , [ 0, 4, 8, 12, 16, 20 ] +-- ] +-- , [ [ 1, 1, 1, 1, 1, 1 ] +-- , [ 1, 2, 3, 4, 5, 6 ] +-- , [ 1, 3, 5, 7, 9, 11 ] +-- , [ 1, 4, 7, 10, 13, 16 ] +-- , [ 1, 5, 9, 13, 17, 21 ] +-- ] +-- , [ [ 2, 2, 2, 2, 2, 2 ] +-- , [ 2, 3, 4, 5, 6, 7 ] +-- , [ 2, 4, 6, 8, 10, 12 ] +-- , [ 2, 5, 8, 11, 14, 17 ] +-- , [ 2, 6, 10, 14, 18, 22 ] +-- ] +-- , [ [ 3, 3, 3, 3, 3, 3 ] +-- , [ 3, 4, 5, 6, 7, 8 ] +-- , [ 3, 5, 7, 9, 11, 13 ] +-- , [ 3, 6, 9, 12, 15, 18 ] +-- , [ 3, 7, 11, 15, 19, 23 ] +-- ] +-- ] +-- >>> productArraysM $ outerSlices arr +-- Array P Seq (Sz (5 :. 6)) +-- [ [ 0, 0, 0, 0, 0, 0 ] +-- , [ 0, 24, 120, 360, 840, 1680 ] +-- , [ 0, 120, 840, 3024, 7920, 17160 ] +-- , [ 0, 360, 3024, 11880, 32760, 73440 ] +-- , [ 0, 840, 7920, 32760, 93024, 212520 ] +-- ] +-- >>> productArraysM $ innerSlices arr +-- Array D Seq (Sz (4 :. 5)) +-- [ [ 0, 0, 0, 0, 0 ] +-- , [ 1, 720, 10395, 58240, 208845 ] +-- , [ 64, 5040, 46080, 209440, 665280 ] +-- , [ 729, 20160, 135135, 524880, 1514205 ] +-- ] +-- +-- @since 1.0.0 +productArraysM :: + (Foldable t, Load r ix e, Numeric r e, MonadThrow m) => t (Array r ix e) -> m (Array r ix e) +productArraysM as = + case F.toList as of + [] -> pure empty + (x:xs) -> F.foldlM (.*.) x xs +{-# INLINE productArraysM #-} From 9612ed8ada1eb055bd31d5a4ff320160f43a40b0 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sun, 11 Jul 2021 18:52:06 +0300 Subject: [PATCH 34/65] Reduce duplication in changelog --- massiv/CHANGELOG.md | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/massiv/CHANGELOG.md b/massiv/CHANGELOG.md index 4643994b..9d32f240 100644 --- a/massiv/CHANGELOG.md +++ b/massiv/CHANGELOG.md @@ -17,10 +17,7 @@ * Remove specialized `DW` instances that used tuples as indices. * Remove `OuterSlice L` instance * Add `Strategy` and move `setComp` (from `Construct`) and `getComp` (from `Load`) in there. -* Remove `ix` from `Mutable` -* Remove `ix` from `Manifest` -* Remove `ix` from `Source` -* Remove `ix` from `Resize` +* Remove `ix` from `Mutable`, `Manifest`, `Source` and `Resize` * Remove `liftArray2`. * Prevent `showsArrayPrec` from changing index type * Change function argument to monadic action for `unstablePartitionM` and `unsafeUnstablePartitionM` From d1a72c8ea9d60344e827e4ab84f541b1bcf19c7d Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Mon, 12 Jul 2021 01:32:55 +0300 Subject: [PATCH 35/65] Use a scheduler version with primitive ST. Push array uses ST --- massiv-bench/bench/Concat.hs | 13 ++-- massiv-bench/bench/Plus.hs | 4 +- massiv-bench/stack-ghc-8.4.yaml | 6 +- massiv/massiv.cabal | 1 + massiv/src/Data/Massiv/Array/Delayed/Push.hs | 71 ++++++++++--------- .../src/Data/Massiv/Array/Delayed/Stream.hs | 3 +- .../src/Data/Massiv/Array/Delayed/Windowed.hs | 16 ++--- .../Data/Massiv/Array/Manifest/Internal.hs | 4 +- massiv/src/Data/Massiv/Array/Mutable.hs | 46 ++++++------ .../src/Data/Massiv/Array/Mutable/Internal.hs | 16 ++--- massiv/src/Data/Massiv/Array/Numeric.hs | 4 +- massiv/src/Data/Massiv/Array/Ops/Construct.hs | 8 +-- .../Data/Massiv/Array/Ops/Fold/Internal.hs | 60 ++++++++-------- massiv/src/Data/Massiv/Array/Ops/Map.hs | 18 +++-- massiv/src/Data/Massiv/Array/Ops/Sort.hs | 19 ++--- massiv/src/Data/Massiv/Array/Ops/Transform.hs | 36 +++++----- massiv/src/Data/Massiv/Core/Common.hs | 58 ++++++++------- massiv/src/Data/Massiv/Core/Iterator.hs | 24 ++++--- stack.yaml | 6 +- 19 files changed, 220 insertions(+), 193 deletions(-) diff --git a/massiv-bench/bench/Concat.hs b/massiv-bench/bench/Concat.hs index bb121288..c5beb795 100644 --- a/massiv-bench/bench/Concat.hs +++ b/massiv-bench/bench/Concat.hs @@ -4,6 +4,7 @@ module Main where import Control.Scheduler +import Control.Monad.ST import Criterion.Main import Data.Bifunctor import Data.Massiv.Array as A @@ -22,19 +23,19 @@ main :: IO () main = do let !sz = Sz (600 :. 1000) arrays :: [Matrix P Int] <- evaluate . force =<< M.replicateM 5 (makeRandomArray sz) - _vectors :: [Vector P Int] <- evaluate $ force $ P.map (resize' (Sz (totalElem sz))) arrays + vectors :: [Vector P Int] <- evaluate $ force $ P.map (resize' (Sz (totalElem sz))) arrays defaultMain [ bgroup "Concat" - [ bench "concatM" $ whnf (computeAs P . concat' 2) arrays + [ bench "concatM" $ whnfIO (computeAs P <$> concatM 2 arrays) , bench "concatMutableM" $ whnfIO (concatMutableM arrays :: IO (Matrix P Int)) , bench "concatMutableM DL" $ whnfIO (concatMutableM (P.map toLoadArray arrays) :: IO (Matrix P Int)) , bench "concatOuterM" $ - whnf (computeAs P . throwEither . concatOuterM . P.map toLoadArray) arrays + whnfIO (computeAs P <$> concatOuterM (P.map toLoadArray arrays)) , bench "concatNewM" $ whnfIO $ concatNewM arrays - --, bench "mconcat (DL)" $ whnf (A.computeAs P . mconcat . P.map toLoadArray) vectors + , bench "mconcat (DL)" $ whnf (A.computeAs P . mconcat . P.map toLoadArray) vectors ] ] @@ -62,7 +63,7 @@ concatMutableM arrsF = unsafeCreateArray_ (foldMap getComp arrsF) newSz $ \scheduler marr -> do let arrayLoader !offset arr = do scheduleWork scheduler $ do - loadArrayM scheduler arr (\i -> unsafeLinearWrite marr (i + offset)) + stToIO $ loadArrayM scheduler arr (\i -> unsafeLinearWrite marr (i + offset)) pure (offset + totalElem (size arr)) foldM_ arrayLoader 0 $ a : arrs {-# INLINE concatMutableM #-} @@ -89,7 +90,7 @@ concatNewM arrsF = let kTotal = SafeSz $ F.foldl' (+) k ks newSz <- insertSzM (SafeSz szl) n kTotal unsafeCreateArray_ (foldMap getComp arrsF) newSz $ \scheduler marr -> do - let arrayLoader !kAcc (kCur, arr) = do + let arrayLoader !kAcc (kCur, arr) = stToIO $ do scheduleWork scheduler $ iforM_ arr $ \ix e -> let i = getDim' ix n diff --git a/massiv-bench/bench/Plus.hs b/massiv-bench/bench/Plus.hs index f96effaf..017ebfdd 100644 --- a/massiv-bench/bench/Plus.hs +++ b/massiv-bench/bench/Plus.hs @@ -18,7 +18,7 @@ main = do let arrD = delay arr in bgroup "Seq" - [ bench "(+) D" $ whnf (A.computeAs U . (+) arrD) arrD + [ bench "(+) D" $ whnf (A.computeAs U . (!+!) arrD) arrD --, bench "(.+)" $ whnf (A.computeAs U . (.+) arr) arr , bench "zipWith (+)" $ whnf (A.computeAs U . A.zipWith (+) arr) arr ] @@ -26,7 +26,7 @@ main = do let arrD = delay arr in bgroup "Par" - [ bench "(+) D" $ whnf (A.computeAs U . (+) arrD) arrD + [ bench "(+) D" $ whnf (A.computeAs U . (!+!) arrD) arrD --, bench "(.+)" $ whnf (A.computeAs U . (.+) arr) arr , bench "zipWith (+)" $ whnf (A.computeAs U . A.zipWith (+) arr) arr ] diff --git a/massiv-bench/stack-ghc-8.4.yaml b/massiv-bench/stack-ghc-8.4.yaml index c733f2d9..c6745ad5 100644 --- a/massiv-bench/stack-ghc-8.4.yaml +++ b/massiv-bench/stack-ghc-8.4.yaml @@ -5,6 +5,10 @@ extra-deps: - '../massiv/' - pvar-1.0.0.0@sha256:3d4a6855b0960baee78f6956f082eb8aa1cede52d2955b7faef186d1133f7964,1893 - primitive-0.7.1.0@sha256:6a237bb338bcc43193077ff8e8c0f0ce2de14c652231496a15672e8b563a07e2,2604 -- scheduler-1.5.0@sha256:8b43f2991bf9a720b12192ba99525f705a44aeae9541a7bd73fbc7e7b56fd8f0,2437 +#- scheduler-1.5.0@sha256:8b43f2991bf9a720b12192ba99525f705a44aeae9541a7bd73fbc7e7b56fd8f0,2437 - random-1.2.0@sha256:4321209c8faedc034810ea8ed0dbc4a36f1a1df97b75af024219f2f533da57de,6094 - splitmix-0.1.0.3 +- github: lehins/haskell-scheduler + commit: ad2c5383cbf8c1a7b840c99c7695efdd225c48d5 + subdirs: + - scheduler diff --git a/massiv/massiv.cabal b/massiv/massiv.cabal index dc74308b..858e365e 100644 --- a/massiv/massiv.cabal +++ b/massiv/massiv.cabal @@ -98,6 +98,7 @@ library -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints + -Wno-simplifiable-class-constraints test-suite doctests type: exitcode-stdio-1.0 diff --git a/massiv/src/Data/Massiv/Array/Delayed/Push.hs b/massiv/src/Data/Massiv/Array/Delayed/Push.hs index 88886aa2..56eef074 100644 --- a/massiv/src/Data/Massiv/Array/Delayed/Push.hs +++ b/massiv/src/Data/Massiv/Array/Delayed/Push.hs @@ -20,6 +20,7 @@ module Data.Massiv.Array.Delayed.Push ( DL(..) , Array(..) + , Loader , toLoadArray , makeLoadArrayS , makeLoadArray @@ -41,16 +42,22 @@ import Prelude hiding (map, zipWith) -- | Delayed load representation. Also known as Push array. data DL = DL deriving Show +type Loader e + = forall s. Scheduler s () + -> Ix1 + -> (Ix1 -> e -> ST s ()) + -> (Ix1 -> Sz1 -> e -> ST s ()) + -> ST s () + data instance Array DL ix e = DLArray { dlComp :: !Comp , dlSize :: !(Sz ix) - , dlLoad :: forall m . Monad m - => Scheduler m () + , dlLoad :: forall s. Scheduler s () -> Ix1 -- start loading at this linear index - -> (Ix1 -> e -> m ()) -- linear element writing action - -> (Ix1 -> Sz1 -> e -> m ()) -- linear region setting action - -> m () + -> (Ix1 -> e -> ST s ()) -- linear element writing action + -> (Ix1 -> Sz1 -> e -> ST s ()) -- linear region setting action + -> ST s () } instance Strategy DL where @@ -93,8 +100,8 @@ mconcatDL !arrs = DLArray {dlComp = foldMap getComp arrs, dlSize = SafeSz k, dlLoad = load} where !k = F.foldl' (+) 0 (unSz . size <$> arrs) - load :: Monad m => - Scheduler m () -> Ix1 -> (Ix1 -> e -> m ()) -> (Ix1 -> Sz1 -> e -> m ()) -> m () + load :: forall s . + Scheduler s () -> Ix1 -> (Ix1 -> e -> ST s ()) -> (Ix1 -> Sz1 -> e -> ST s ()) -> ST s () load scheduler startAt dlWrite dlSet = let loadArr !startAtCur DLArray {dlSize = SafeSz kCur, dlLoad} = do let !endAtCur = startAtCur + kCur @@ -112,8 +119,8 @@ mappendDL (DLArray c1 sz1 load1) (DLArray c2 sz2 load2) = where !k1 = unSz sz1 !k2 = unSz sz2 - load :: Monad n => - Scheduler n () -> Ix1 -> (Ix1 -> e -> n ()) -> (Ix1 -> Sz1 -> e -> n ()) -> n () + load :: forall s. + Scheduler s () -> Ix1 -> (Ix1 -> e -> ST s ()) -> (Ix1 -> Sz1 -> e -> ST s ()) -> ST s () load scheduler !startAt dlWrite dlSet = do scheduleWork_ scheduler $ load1 scheduler startAt dlWrite dlSet scheduleWork_ scheduler $ load2 scheduler (startAt + k1) dlWrite dlSet @@ -136,7 +143,7 @@ appendOuterM (DLArray c1 sz1 load1) (DLArray c2 sz2 load2) = do pure $ DLArray {dlComp = c1 <> c2, dlSize = consSz (liftSz2 (+) i1 i2) szl1, dlLoad = load} where - load :: Monad n => Scheduler n () -> Ix1 -> (Ix1 -> e -> n ()) -> (Ix1 -> Sz1 -> e -> n ()) -> n () + load :: Loader e load scheduler !startAt dlWrite dlSet = do scheduleWork_ scheduler $ load1 scheduler startAt dlWrite dlSet scheduleWork_ scheduler $ load2 scheduler (startAt + totalElem sz1) dlWrite dlSet @@ -173,8 +180,8 @@ makeLoadArrayS :: -> Array DL ix e makeLoadArrayS sz defVal writer = DLArray Seq sz load where - load :: Monad m => - Scheduler m () -> Ix1 -> (Ix1 -> e -> m ()) -> (Ix1 -> Sz1 -> e -> m ()) -> m () + load :: forall s. + Scheduler s () -> Ix1 -> (Ix1 -> e -> ST s ()) -> (Ix1 -> Sz1 -> e -> ST s ()) -> ST s () load _scheduler !startAt uWrite uSet = do uSet startAt (toLinearSz sz) defVal let safeWrite !ix !e @@ -199,15 +206,15 @@ makeLoadArray :: -- ^ Size of the resulting array -> e -- ^ Default value to use for all cells that might have been ommitted by the writing function - -> (forall m. Monad m => Scheduler m () -> (ix -> e -> m Bool) -> m ()) + -> (forall s. Scheduler s () -> (ix -> e -> ST s Bool) -> ST s ()) -- ^ Writing function that described which elements to write into the target array. It -- accepts a scheduler, that can be used for parallelization, as well as a safe element -- writing function. -> Array DL ix e makeLoadArray comp sz defVal writer = DLArray comp sz load where - load :: Monad m => - Scheduler m () -> Ix1 -> (Ix1 -> e -> m ()) -> (Ix1 -> Sz1 -> e -> m ()) -> m () + load :: forall s. + Scheduler s () -> Ix1 -> (Ix1 -> e -> ST s ()) -> (Ix1 -> Sz1 -> e -> ST s ()) -> ST s () load scheduler !startAt uWrite uSet = do uSet startAt (toLinearSz sz) defVal let safeWrite !ix !e @@ -234,7 +241,7 @@ unsafeMakeLoadArray :: -> Maybe e -- ^ An element to use for initialization of the mutable array that will be created in -- the future - -> (forall m. Monad m => Scheduler m () -> Ix1 -> (Ix1 -> e -> m ()) -> m ()) + -> (forall s. Scheduler s () -> Ix1 -> (Ix1 -> e -> ST s ()) -> ST s ()) -- ^ This function accepts: -- -- * A scheduler that can be used for parallelization of loading @@ -246,8 +253,7 @@ unsafeMakeLoadArray :: -> Array DL ix e unsafeMakeLoadArray comp sz mDefVal writer = DLArray comp sz load where - load :: Monad m => - Scheduler m () -> Ix1 -> (Ix1 -> e -> m ()) -> (Ix1 -> Sz1 -> e -> m ()) -> m () + load :: Loader e load scheduler startAt uWrite uSet = do S.traverse_ (uSet startAt (toLinearSz sz)) mDefVal writer scheduler startAt uWrite @@ -263,12 +269,12 @@ unsafeMakeLoadArrayAdjusted :: => Comp -> Sz ix -> Maybe e - -> (forall m. Monad m => Scheduler m () -> (Ix1 -> e -> m ()) -> m ()) + -> (forall s. Scheduler s () -> (Ix1 -> e -> ST s ()) -> ST s ()) -> Array DL ix e unsafeMakeLoadArrayAdjusted comp sz mDefVal writer = DLArray comp sz load where - load :: Monad m => - Scheduler m () -> Ix1 -> (Ix1 -> e -> m ()) -> (Ix1 -> Sz1 -> e -> m ()) -> m () + load :: forall s. + Scheduler s () -> Ix1 -> (Ix1 -> e -> ST s ()) -> (Ix1 -> Sz1 -> e -> ST s ()) -> ST s () load scheduler !startAt uWrite dlSet = do S.traverse_ (dlSet startAt (toLinearSz sz)) mDefVal writer scheduler (\i -> uWrite (startAt + i)) @@ -285,8 +291,8 @@ toLoadArray :: toLoadArray arr = DLArray (getComp arr) sz load where !sz = size arr - load :: Monad m => - Scheduler m () -> Ix1 -> (Ix1 -> e -> m ()) -> (Ix1 -> Sz1 -> e -> m ()) -> m () + load :: forall s. + Scheduler s () -> Ix1 -> (Ix1 -> e -> ST s ()) -> (Ix1 -> Sz1 -> e -> ST s ()) -> ST s () load scheduler !startAt dlWrite dlSet = loadArrayWithSetM scheduler arr (dlWrite . (+ startAt)) (\offset -> dlSet (offset + startAt)) {-# INLINE load #-} @@ -305,8 +311,7 @@ fromStrideLoad stride arr = DLArray (getComp arr) newsz load where !newsz = strideSize stride (size arr) - load :: Monad m => - Scheduler m () -> Ix1 -> (Ix1 -> e -> m ()) -> (Ix1 -> Sz1 -> e -> m ()) -> m () + load :: Loader e load scheduler !startAt dlWrite _ = loadArrayWithStrideM scheduler stride newsz arr (\ !i -> dlWrite (i + startAt)) {-# INLINE load #-} @@ -315,8 +320,7 @@ fromStrideLoad stride arr = instance Index ix => Load DL ix e where makeArrayLinear comp sz f = DLArray comp sz load where - load :: Monad m => - Scheduler m () -> Ix1 -> (Ix1 -> e -> m ()) -> (Ix1 -> Sz1 -> e -> m ()) -> m () + load :: Loader e load scheduler startAt dlWrite _ = splitLinearlyWithStartAtM_ scheduler startAt (totalElem sz) (pure . f) dlWrite {-# INLINE load #-} @@ -335,21 +339,20 @@ instance Index ix => Functor (Array DL ix) where overwriteFunctor :: forall ix a b. Index ix => a -> Array DL ix b -> Array DL ix a overwriteFunctor e arr = arr {dlLoad = load} where - load :: Scheduler m () -> Ix1 -> (Ix1 -> a -> m ()) -> (Ix1 -> Sz1 -> a -> m ()) -> m () + load :: Loader a load _ !startAt _ dlSet = dlSet startAt (linearSize arr) e {-# INLINE load #-} {-# INLINE overwriteFunctor #-} loadFunctor :: - Monad m - => Array DL ix a + Array DL ix a -> (a -> b) - -> Scheduler m () + -> Scheduler s () -> Ix1 - -> (Ix1 -> b -> m ()) - -> (Ix1 -> Sz1 -> b -> m ()) - -> m () + -> (Ix1 -> b -> ST s ()) + -> (Ix1 -> Sz1 -> b -> ST s ()) + -> ST s () loadFunctor arr f scheduler startAt uWrite uSet = dlLoad arr scheduler startAt (\ !i e -> uWrite i (f e)) (\o sz e -> uSet o sz (f e)) {-# INLINE loadFunctor #-} diff --git a/massiv/src/Data/Massiv/Array/Delayed/Stream.hs b/massiv/src/Data/Massiv/Array/Delayed/Stream.hs index b7182cad..ce1e171a 100644 --- a/massiv/src/Data/Massiv/Array/Delayed/Stream.hs +++ b/massiv/src/Data/Massiv/Array/Delayed/Stream.hs @@ -24,6 +24,7 @@ module Data.Massiv.Array.Delayed.Stream import Control.Applicative import Control.Monad (void) +import Control.Monad.ST import Data.Coerce import Data.Foldable import Data.Massiv.Array.Delayed.Pull @@ -203,7 +204,7 @@ instance Load DS Ix1 e where S.unstreamIntoM marr (stepsSize sts) (stepsStream sts) {-# INLINE unsafeLoadIntoS #-} - unsafeLoadIntoM marr arr = liftIO $ unsafeLoadIntoS marr arr + unsafeLoadIntoM marr arr = stToIO $ unsafeLoadIntoS marr arr {-# INLINE unsafeLoadIntoM #-} diff --git a/massiv/src/Data/Massiv/Array/Delayed/Windowed.hs b/massiv/src/Data/Massiv/Array/Delayed/Windowed.hs index 089fd200..ac6431eb 100644 --- a/massiv/src/Data/Massiv/Array/Delayed/Windowed.hs +++ b/massiv/src/Data/Massiv/Array/Delayed/Windowed.hs @@ -362,13 +362,13 @@ instance (Index (IxN n), StrideLoad DW (Ix (n - 1)) e) => StrideLoad DW (IxN n) {-# INLINE loadArrayWithStrideM #-} loadArrayWithIxN :: - (Index ix, Monad m, StrideLoad DW (Lower ix) e) - => Scheduler m () + (Index ix, StrideLoad DW (Lower ix) e) + => Scheduler s () -> Stride ix -> Sz ix -> Array DW ix e - -> (Int -> e -> m ()) - -> m () + -> (Int -> e -> ST s ()) + -> ST s () loadArrayWithIxN scheduler stride szResult arr uWrite = do let DWArray darr window = arr DArray {dSize = szSource, dIndex = indexBorder} = darr @@ -410,11 +410,11 @@ loadArrayWithIxN scheduler stride szResult arr uWrite = do loadWithIxN :: - (Index ix, Monad m, Load DW (Lower ix) e) - => Scheduler m () + (Index ix, Load DW (Lower ix) e) + => Scheduler s () -> Array DW ix e - -> (Int -> e -> m ()) - -> m () + -> (Int -> e -> ST s ()) + -> ST s () loadWithIxN scheduler arr uWrite = do let DWArray darr window = arr DArray {dSize = sz, dIndex = indexBorder} = darr diff --git a/massiv/src/Data/Massiv/Array/Manifest/Internal.hs b/massiv/src/Data/Massiv/Array/Manifest/Internal.hs index b7b109cb..bf10d417 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Internal.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Internal.hs @@ -226,7 +226,7 @@ fromRaggedArrayM arr = marr <- unsafeNew sz traverse (\_ -> unsafeFreeze (getComp arr) marr) =<< try (withMassivScheduler_ (getComp arr) $ \scheduler -> - loadRagged scheduler (unsafeLinearWrite marr) 0 (totalElem sz) sz arr) + stToIO $ loadRagged scheduler (unsafeLinearWrite marr) 0 (totalElem sz) sz arr) {-# INLINE fromRaggedArrayM #-} @@ -257,7 +257,7 @@ computeWithStride stride !arr = unsafePerformIO $ do let !sz = strideSize stride (size arr) unsafeCreateArray_ (getComp arr) sz $ \scheduler marr -> - loadArrayWithStrideM scheduler stride sz arr (unsafeLinearWrite marr) + stToIO $ loadArrayWithStrideM scheduler stride sz arr (unsafeLinearWrite marr) {-# INLINE computeWithStride #-} diff --git a/massiv/src/Data/Massiv/Array/Mutable.hs b/massiv/src/Data/Massiv/Array/Mutable.hs index 12595485..9daf6092 100644 --- a/massiv/src/Data/Massiv/Array/Mutable.hs +++ b/massiv/src/Data/Massiv/Array/Mutable.hs @@ -102,6 +102,7 @@ module Data.Massiv.Array.Mutable import Data.Maybe (fromMaybe) import Control.Monad (void, when, unless, (>=>)) import Control.Monad.ST +import Control.Monad.Primitive import Control.Scheduler import Data.Massiv.Core.Common import Data.Massiv.Array.Mutable.Internal @@ -267,7 +268,7 @@ loadArrayS :: -> m (MArray (PrimState m) r ix e) loadArrayS arr = do marr <- unsafeNewUpper arr - unsafeLoadIntoS marr arr + stToPrim $ unsafeLoadIntoS marr arr {-# INLINE loadArrayS #-} @@ -300,7 +301,7 @@ computeInto !mArr !arr = unless (totalElem (msize mArr) == totalElem (size arr)) $ throwM $ SizeElementsMismatchException (msize mArr) (size arr) withMassivScheduler_ (getComp arr) $ \scheduler -> - loadArrayM scheduler arr (unsafeLinearWrite mArr) + stToPrim $ loadArrayM scheduler arr (unsafeLinearWrite mArr) {-# INLINE computeInto #-} @@ -334,11 +335,11 @@ makeMArrayLinearS sz f = do -- -- @since 0.3.0 makeMArray :: - forall r ix e m. (PrimMonad m, MonadUnliftIO m, Mutable r e, Index ix) + forall r ix e m. (MonadUnliftIO m, Mutable r e, Index ix) => Comp -> Sz ix -> (ix -> m e) - -> m (MArray (PrimState m) r ix e) + -> m (MArray RealWorld r ix e) makeMArray comp sz f = makeMArrayLinear comp sz (f . fromLinearIndex sz) {-# INLINE makeMArray #-} @@ -347,15 +348,16 @@ makeMArray comp sz f = makeMArrayLinear comp sz (f . fromLinearIndex sz) -- -- @since 0.3.0 makeMArrayLinear :: - forall r ix e m. (PrimMonad m, MonadUnliftIO m, Mutable r e, Index ix) + forall r ix e m. (MonadUnliftIO m, Mutable r e, Index ix) => Comp -> Sz ix -> (Int -> m e) - -> m (MArray (PrimState m) r ix e) + -> m (MArray RealWorld r ix e) makeMArrayLinear comp sz f = do - marr <- unsafeNew sz + marr <- liftIO $ unsafeNew sz withScheduler_ comp $ \scheduler -> - splitLinearlyWithM_ scheduler (totalElem sz) f (unsafeLinearWrite marr) + withRunInIO $ \run -> + splitLinearlyWithM_ scheduler (totalElem sz) (run . f) (unsafeLinearWrite marr) return marr {-# INLINE makeMArrayLinear #-} @@ -376,16 +378,16 @@ makeMArrayLinear comp sz f = do -- @since 0.3.0 -- createArray_ :: - forall r ix e a m. (Mutable r e, Index ix, PrimMonad m, MonadUnliftIO m) + forall r ix e a m. (Mutable r e, Index ix, MonadUnliftIO m) => Comp -- ^ Computation strategy to use after `MArray` gets frozen and onward. -> Sz ix -- ^ Size of the newly created array - -> (Scheduler m () -> MArray (PrimState m) r ix e -> m a) + -> (Scheduler RealWorld () -> MArray RealWorld r ix e -> m a) -- ^ An action that should fill all elements of the brand new mutable array -> m (Array r ix e) createArray_ comp sz action = do - marr <- newMArray' sz + marr <- liftIO $ newMArray' sz withScheduler_ comp (`action` marr) - unsafeFreeze comp marr + liftIO $ unsafeFreeze comp marr {-# INLINE createArray_ #-} -- | Just like `createArray_`, but together with `Array` it returns results of scheduled filling @@ -394,16 +396,16 @@ createArray_ comp sz action = do -- @since 0.3.0 -- createArray :: - forall r ix e a m b. (Mutable r e, Index ix, PrimMonad m, MonadUnliftIO m) + forall r ix e a m b. (Mutable r e, Index ix, MonadUnliftIO m) => Comp -- ^ Computation strategy to use after `MArray` gets frozen and onward. -> Sz ix -- ^ Size of the newly created array - -> (Scheduler m a -> MArray (PrimState m) r ix e -> m b) + -> (Scheduler RealWorld a -> MArray RealWorld r ix e -> m b) -- ^ An action that should fill all elements of the brand new mutable array -> m ([a], Array r ix e) createArray comp sz action = do - marr <- newMArray' sz + marr <- liftIO $ newMArray' sz a <- withScheduler comp (`action` marr) - arr <- unsafeFreeze comp marr + arr <- liftIO $ unsafeFreeze comp marr return (a, arr) {-# INLINE createArray #-} @@ -521,7 +523,7 @@ generateArrayLinearS sz gen = do -- -- @since 0.2.6 generateArray :: - forall r ix e m. (MonadUnliftIO m, PrimMonad m, Mutable r e, Index ix) + forall r ix e m. (MonadUnliftIO m, Mutable r e, Index ix) => Comp -> Sz ix -> (ix -> m e) @@ -534,12 +536,12 @@ generateArray comp sz f = generateArrayLinear comp sz (f . fromLinearIndex sz) -- -- @since 0.3.0 generateArrayLinear :: - forall r ix e m. (MonadUnliftIO m, PrimMonad m, Mutable r e, Index ix) + forall r ix e m. (MonadUnliftIO m, Mutable r e, Index ix) => Comp -> Sz ix -> (Int -> m e) -> m (Array r ix e) -generateArrayLinear comp sz f = makeMArrayLinear comp sz f >>= unsafeFreeze comp +generateArrayLinear comp sz f = makeMArrayLinear comp sz f >>= liftIO . unsafeFreeze comp {-# INLINE generateArrayLinear #-} @@ -802,7 +804,7 @@ iforLinearPrimM marr f = withMArray :: (Mutable r e, Index ix, MonadUnliftIO m) => Array r ix e - -> (Scheduler m a -> MArray RealWorld r ix e -> m b) + -> (Scheduler RealWorld a -> MArray RealWorld r ix e -> m b) -> m ([a], Array r ix e) withMArray arr action = do marr <- thaw arr @@ -826,7 +828,7 @@ withMArray arr action = do withMArray_ :: (Mutable r e, Index ix, MonadUnliftIO m) => Array r ix e - -> (Scheduler m () -> MArray RealWorld r ix e -> m a) + -> (Scheduler RealWorld () -> MArray RealWorld r ix e -> m a) -> m (Array r ix e) withMArray_ arr action = do marr <- thaw arr @@ -842,7 +844,7 @@ withMArray_ arr action = do withLoadMArray_ :: forall r ix e r' m b. (Load r' ix e, Mutable r e, MonadUnliftIO m) => Array r' ix e - -> (Scheduler m () -> MArray RealWorld r ix e -> m b) + -> (Scheduler RealWorld () -> MArray RealWorld r ix e -> m b) -> m (Array r ix e) withLoadMArray_ arr action = do marr <- loadArray arr diff --git a/massiv/src/Data/Massiv/Array/Mutable/Internal.hs b/massiv/src/Data/Massiv/Array/Mutable/Internal.hs index b7912b7a..db484c96 100644 --- a/massiv/src/Data/Massiv/Array/Mutable/Internal.hs +++ b/massiv/src/Data/Massiv/Array/Mutable/Internal.hs @@ -38,16 +38,16 @@ unsafeCreateArrayS sz action = do -- -- @since 0.5.0 unsafeCreateArray :: - forall r ix e a m b. (Mutable r e, Index ix, PrimMonad m, MonadUnliftIO m) + forall r ix e a m b. (Mutable r e, Index ix, MonadUnliftIO m) => Comp -- ^ Computation strategy to use after `MArray` gets frozen and onward. -> Sz ix -- ^ Size of the newly created array - -> (Scheduler m a -> MArray (PrimState m) r ix e -> m b) + -> (Scheduler RealWorld a -> MArray RealWorld r ix e -> m b) -- ^ An action that should fill all elements of the brand new mutable array -> m ([a], Array r ix e) unsafeCreateArray comp sz action = do - marr <- unsafeNew sz + marr <- liftIO $ unsafeNew sz a <- withScheduler comp (`action` marr) - arr <- unsafeFreeze comp marr + arr <- liftIO $ unsafeFreeze comp marr return (a, arr) {-# INLINE unsafeCreateArray #-} @@ -56,15 +56,15 @@ unsafeCreateArray comp sz action = do -- -- @since 0.5.0 unsafeCreateArray_ :: - forall r ix e a m b. (Mutable r e, Index ix, PrimMonad m, MonadUnliftIO m) + forall r ix e a m b. (Mutable r e, Index ix, MonadUnliftIO m) => Comp -- ^ Computation strategy to use after `MArray` gets frozen and onward. -> Sz ix -- ^ Size of the newly created array - -> (Scheduler m a -> MArray (PrimState m) r ix e -> m b) + -> (Scheduler RealWorld a -> MArray RealWorld r ix e -> m b) -- ^ An action that should fill all elements of the brand new mutable array -> m (Array r ix e) unsafeCreateArray_ comp sz action = do - marr <- unsafeNew sz + marr <- liftIO $ unsafeNew sz withScheduler_ comp (`action` marr) - arr <- unsafeFreeze comp marr + arr <- liftIO $ unsafeFreeze comp marr return arr {-# INLINE unsafeCreateArray_ #-} diff --git a/massiv/src/Data/Massiv/Array/Numeric.hs b/massiv/src/Data/Massiv/Array/Numeric.hs index 45633ca4..96ed356d 100644 --- a/massiv/src/Data/Massiv/Array/Numeric.hs +++ b/massiv/src/Data/Massiv/Array/Numeric.hs @@ -350,7 +350,7 @@ unsafeDotProductIO :: unsafeDotProductIO v1 v2 = do results <- withScheduler comp $ \scheduler -> - splitLinearly (numWorkers scheduler) totalLength $ \chunkLength slackStart -> do + splitLinearly (numWorkers scheduler) totalLength $ \chunkLength slackStart -> liftIO $ do let n = SafeSz chunkLength loopM_ 0 (< slackStart) (+ chunkLength) $ \ !start -> scheduleWork scheduler $ @@ -384,7 +384,7 @@ powerSumArrayIO :: powerSumArrayIO v p = do results <- withScheduler (getComp v) $ \scheduler -> - splitLinearly (numWorkers scheduler) totalLength $ \chunkLength slackStart -> do + splitLinearly (numWorkers scheduler) totalLength $ \chunkLength slackStart -> liftIO $ do let n = SafeSz chunkLength loopM_ 0 (< slackStart) (+ chunkLength) $ \ !start -> scheduleWork scheduler $ pure $! powerSumArray (unsafeLinearSlice start n v) p diff --git a/massiv/src/Data/Massiv/Array/Ops/Construct.hs b/massiv/src/Data/Massiv/Array/Ops/Construct.hs index c5de03f9..1cb5629c 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Construct.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Construct.hs @@ -231,8 +231,7 @@ iunfoldrS_ :: -> Array DL ix e iunfoldrS_ sz f acc0 = DLArray {dlComp = Seq, dlSize = sz, dlLoad = load} where - load :: Monad m => - Scheduler m () -> Ix1 -> (Ix1 -> e -> m ()) -> (Ix1 -> Sz1 -> e -> m ()) -> m () + load :: Loader e load _ startAt dlWrite _ = void $ loopM startAt (< totalElem sz + startAt) (+ 1) acc0 $ \ !i !acc -> @@ -262,8 +261,7 @@ iunfoldlS_ :: -> Array DL ix e iunfoldlS_ sz f acc0 = DLArray {dlComp = Seq, dlSize = sz, dlLoad = load} where - load :: Monad m => - Scheduler m () -> Ix1 -> (Ix1 -> e -> m ()) -> (Ix1 -> Sz1 -> e -> m ()) -> m () + load :: Loader e load _ startAt dlWrite _ = void $ loopDeepM startAt (< totalElem sz + startAt) (+ 1) acc0 $ \ !i !acc -> @@ -316,7 +314,7 @@ randomArray :: randomArray gen splitGen nextRandom comp sz = unsafeMakeLoadArray comp sz Nothing load where !totalLength = totalElem sz - load :: Monad m => Scheduler m () -> Int -> (Int -> e -> m ()) -> m () + load :: forall s. Scheduler s () -> Ix1 -> (Ix1 -> e -> ST s ()) -> ST s () load scheduler startAt writeAt = splitLinearly (numWorkers scheduler) totalLength $ \chunkLength slackStart -> do let slackStartAt = slackStart + startAt diff --git a/massiv/src/Data/Massiv/Array/Ops/Fold/Internal.hs b/massiv/src/Data/Massiv/Array/Ops/Fold/Internal.hs index 4e54762a..35ac4299 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Fold/Internal.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Fold/Internal.hs @@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -- | -- Module : Data.Massiv.Array.Ops.Fold.Internal @@ -322,16 +323,17 @@ ifoldlIO f !initAcc g !tAcc !arr let !sz = size arr !totalLength = totalElem sz results <- - withScheduler (getComp arr) $ \scheduler -> - splitLinearly (numWorkers scheduler) totalLength $ \chunkLength slackStart -> do - loopM_ 0 (< slackStart) (+ chunkLength) $ \ !start -> - scheduleWork scheduler $ - iterLinearM sz start (start + chunkLength) 1 (<) initAcc $ \ !i ix !acc -> - f acc ix (unsafeLinearIndex arr i) - when (slackStart < totalLength) $ - scheduleWork scheduler $ - iterLinearM sz slackStart totalLength 1 (<) initAcc $ \ !i ix !acc -> - f acc ix (unsafeLinearIndex arr i) + withScheduler (getComp arr) $ \scheduler -> do + withRunInIO $ \run -> do + splitLinearly (numWorkers scheduler) totalLength $ \chunkLength slackStart -> do + loopM_ 0 (< slackStart) (+ chunkLength) $ \ !start -> + scheduleWork scheduler $ run $ + iterLinearM sz start (start + chunkLength) 1 (<) initAcc $ \ !i ix !acc -> + f acc ix (unsafeLinearIndex arr i) + when (slackStart < totalLength) $ + scheduleWork scheduler $ run $ + iterLinearM sz slackStart totalLength 1 (<) initAcc $ \ !i ix !acc -> + f acc ix (unsafeLinearIndex arr i) F.foldlM g tAcc results {-# INLINE ifoldlIO #-} @@ -342,7 +344,7 @@ ifoldlIO f !initAcc g !tAcc !arr -- @since 1.0.0 splitReduce :: (MonadUnliftIO m, Index ix, Source r e) - => (Scheduler m a -> Vector r e -> m a) + => (Scheduler RealWorld a -> Vector r e -> m a) -> (b -> a -> m b) -- ^ Folding action that is applied to the results of a parallel fold -> b -- ^ Accumulator for chunks folding -> Array r ix e @@ -352,13 +354,14 @@ splitReduce f g !tAcc !arr = do !totalLength = totalElem sz results <- withScheduler (getComp arr) $ \scheduler -> do - splitLinearly (numWorkers scheduler) totalLength $ \chunkLength slackStart -> do - loopM_ 0 (< slackStart) (+ chunkLength) $ \ !start -> - scheduleWork scheduler $ f scheduler $ - unsafeLinearSlice start (SafeSz chunkLength) arr - when (slackStart < totalLength) $ - scheduleWork scheduler $ f scheduler $ - unsafeLinearSlice slackStart (SafeSz (totalLength - slackStart)) arr + withRunInIO $ \run -> do + splitLinearly (numWorkers scheduler) totalLength $ \chunkLength slackStart -> do + loopM_ 0 (< slackStart) (+ chunkLength) $ \ !start -> + scheduleWork scheduler $ run $ f scheduler $ + unsafeLinearSlice start (SafeSz chunkLength) arr + when (slackStart < totalLength) $ + scheduleWork scheduler $ run $ f scheduler $ + unsafeLinearSlice slackStart (SafeSz (totalLength - slackStart)) arr F.foldlM g tAcc results {-# INLINE splitReduce #-} @@ -375,16 +378,17 @@ ifoldrIO f !initAcc g !tAcc !arr let !sz = size arr !totalLength = totalElem sz results <- - withScheduler (getComp arr) $ \ scheduler -> - splitLinearly (numWorkers scheduler) totalLength $ \ chunkLength slackStart -> do - when (slackStart < totalLength) $ - scheduleWork scheduler $ - iterLinearM sz (totalLength - 1) slackStart (-1) (>=) initAcc $ \ !i ix !acc -> - f ix (unsafeLinearIndex arr i) acc - loopM_ slackStart (> 0) (subtract chunkLength) $ \ !start -> - scheduleWork scheduler $ - iterLinearM sz (start - 1) (start - chunkLength) (-1) (>=) initAcc $ \ !i ix !acc -> + withRunInIO $ \run -> do + withScheduler (getComp arr) $ \ scheduler -> + splitLinearly (numWorkers scheduler) totalLength $ \ chunkLength slackStart -> do + when (slackStart < totalLength) $ + scheduleWork scheduler $ run $ + iterLinearM sz (totalLength - 1) slackStart (-1) (>=) initAcc $ \ !i ix !acc -> f ix (unsafeLinearIndex arr i) acc + loopM_ slackStart (> 0) (subtract chunkLength) $ \ !start -> + scheduleWork scheduler $ run $ + iterLinearM sz (start - 1) (start - chunkLength) (-1) (>=) initAcc $ \ !i ix !acc -> + f ix (unsafeLinearIndex arr i) acc F.foldlM (flip g) tAcc results {-# INLINE ifoldrIO #-} @@ -409,7 +413,7 @@ anySu f arr = go 0 -- | Implementaton of `any` on a slice of an array with short-circuiting using batch cancellation. anySliceSuM :: (Index ix, Source r e) - => Batch IO Bool + => Batch RealWorld Bool -> Ix1 -> Sz1 -> (e -> Bool) diff --git a/massiv/src/Data/Massiv/Array/Ops/Map.hs b/massiv/src/Data/Massiv/Array/Ops/Map.hs index 17d66c96..f435efd4 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Map.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Map.hs @@ -70,6 +70,7 @@ module Data.Massiv.Array.Ops.Map ) where import Control.Monad (void) +import Control.Monad.Primitive import Control.Scheduler import Data.Coerce import Data.Massiv.Array.Delayed.Pull @@ -540,14 +541,19 @@ mapIO_ action = imapIO_ (const action) -- @since 0.2.6 imapIO_ :: (Index ix, Source r e, MonadUnliftIO m) => (ix -> e -> m a) -> Array r ix e -> m () imapIO_ action arr = - withScheduler_ (getComp arr) $ \scheduler -> imapSchedulerM_ scheduler action arr + withScheduler_ (getComp arr) $ \scheduler -> + withRunInIO $ \run -> imapSchedulerM_ scheduler (\ix -> run . action ix) arr {-# INLINE imapIO_ #-} -- | Same as `imapM_`, but will use the supplied scheduler. -- -- @since 0.3.1 imapSchedulerM_ :: - (Index ix, Source r e, Monad m) => Scheduler m () -> (ix -> e -> m a) -> Array r ix e -> m () + (Index ix, Source r e, MonadPrimBase s m) + => Scheduler s () + -> (ix -> e -> m a) + -> Array r ix e + -> m () imapSchedulerM_ scheduler action arr = do let sz = size arr splitLinearlyWith_ @@ -562,7 +568,11 @@ imapSchedulerM_ scheduler action arr = do -- -- @since 0.3.1 iforSchedulerM_ :: - (Index ix, Source r e, Monad m) => Scheduler m () -> Array r ix e -> (ix -> e -> m a) -> m () + (Index ix, Source r e, MonadPrimBase s m) + => Scheduler s () + -> Array r ix e + -> (ix -> e -> m a) + -> m () iforSchedulerM_ scheduler arr action = imapSchedulerM_ scheduler action arr {-# INLINE iforSchedulerM_ #-} @@ -571,7 +581,7 @@ iforSchedulerM_ scheduler arr action = imapSchedulerM_ scheduler action arr -- -- @since 0.2.6 imapIO :: - forall r ix b r' a m. (Source r' a, Mutable r b, Index ix, MonadUnliftIO m, PrimMonad m) + forall r ix b r' a m. (Source r' a, Mutable r b, Index ix, MonadUnliftIO m) => (ix -> a -> m b) -> Array r' ix a -> m (Array r ix b) diff --git a/massiv/src/Data/Massiv/Array/Ops/Sort.hs b/massiv/src/Data/Massiv/Array/Ops/Sort.hs index 2754e0f5..8bc622fe 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Sort.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Sort.hs @@ -21,6 +21,7 @@ module Data.Massiv.Array.Ops.Sort import Control.Monad.IO.Unlift import Control.Monad (when) +import Control.Monad.Primitive import Control.Scheduler import Data.Massiv.Array.Delayed.Stream import Data.Massiv.Array.Mutable @@ -129,9 +130,9 @@ quicksortBy f arr = -- -- @since 0.3.2 quicksortM_ :: - (Ord e, Mutable r e, PrimMonad m) - => Scheduler m () - -> MVector (PrimState m) r e + (Ord e, Mutable r e, MonadPrimBase s m) + => Scheduler s () + -> MVector s r e -> m () quicksortM_ = quicksortInternalM_ (\e1 e2 -> pure $ e1 < e2) (\e1 e2 -> pure $ e1 == e2) {-# INLINE quicksortM_ #-} @@ -141,10 +142,10 @@ quicksortM_ = quicksortInternalM_ (\e1 e2 -> pure $ e1 < e2) (\e1 e2 -> pure $ e -- -- @since 0.6.1 quicksortByM_ :: - (Mutable r e, PrimMonad m) + (Mutable r e, MonadPrimBase s m) => (e -> e -> m Ordering) - -> Scheduler m () - -> MVector (PrimState m) r e + -> Scheduler s () + -> MVector s r e -> m () quicksortByM_ compareM = quicksortInternalM_ (\x y -> (LT ==) <$> compareM x y) (\x y -> (EQ ==) <$> compareM x y) @@ -152,11 +153,11 @@ quicksortByM_ compareM = quicksortInternalM_ :: - (Mutable r e, PrimMonad m) + (Mutable r e, MonadPrimBase s m) => (e -> e -> m Bool) -> (e -> e -> m Bool) - -> Scheduler m () - -> MVector (PrimState m) r e + -> Scheduler s () + -> MVector s r e -> m () quicksortInternalM_ fLT fEQ scheduler marr = scheduleWork scheduler $ qsort (numWorkers scheduler) 0 (unSz (msize marr) - 1) diff --git a/massiv/src/Data/Massiv/Array/Ops/Transform.hs b/massiv/src/Data/Massiv/Array/Ops/Transform.hs index 7f733204..a288b3cf 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Transform.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Transform.hs @@ -469,8 +469,7 @@ appendM n !arr1 !arr2 = do unless (szl1 == szl2) $ throwM $ SizeMismatchException sz1 sz2 let !k1' = unSz k1 newSz <- insertSzM szl1 n (SafeSz (k1' + unSz k2)) - let load :: Monad n => - Scheduler n () -> Ix1 -> (Ix1 -> e -> n ()) -> (Ix1 -> Sz1 -> e -> n ()) -> n () + let load :: Loader e load scheduler !startAt dlWrite _dlSet = do scheduleWork scheduler $ iterM_ zeroIndex (unSz sz1) (pureIndex 1) (<) $ \ix -> @@ -521,7 +520,7 @@ concatM :: => Dim -> f (Array r ix e) -> m (Array DL ix e) -concatM n !arrsF = +concatM n arrsF = case L.uncons (F.toList arrsF) of Nothing -> pure empty Just (a, arrs) -> do @@ -537,20 +536,20 @@ concatM n !arrsF = (dropWhile ((== szl) . snd) $ P.zip szs szls) let kTotal = SafeSz $ F.foldl' (+) k ks newSz <- insertSzM (SafeSz szl) n kTotal - let load :: Monad n => - Scheduler n () -> Ix1 -> (Ix1 -> e -> n ()) -> (Ix1 -> Sz1 -> e -> n ()) -> n () + let load :: Loader e load scheduler startAt dlWrite _dlSet = - let arrayLoader !kAcc (kCur, arr) = do + let arrayLoader !kAcc (!kCur, arr) = do scheduleWork scheduler $ - iforM_ arr $ \ix e -> - let i = getDim' ix n - ix' = setDim' ix n (i + kAcc) - in dlWrite (startAt + toLinearIndex newSz ix') e - pure (kAcc + kCur) + iforM_ arr $ \ix e -> do + i <- getDimM ix n + ix' <- setDimM ix n (i + kAcc) + dlWrite (startAt + toLinearIndex newSz ix') e + pure $! kAcc + kCur + {-# INLINE arrayLoader #-} in M.foldM_ arrayLoader 0 $ (k, a) : P.zip ks arrs {-# INLINE load #-} return $ - DLArray {dlComp = foldMap getComp arrsF, dlSize = newSz, dlLoad = load} + DLArray {dlComp = getComp a <> foldMap getComp arrs, dlSize = newSz, dlLoad = load} {-# INLINE concatM #-} @@ -632,8 +631,7 @@ stackSlicesM dim !arrsF = do M.forM_ arrsF $ \arr -> unless (sz == size arr) $ throwM (SizeMismatchException sz (size arr)) newSz <- insertSzM sz dim len - let load :: Monad n => - Scheduler n () -> Ix1 -> (Ix1 -> e -> n ()) -> (Ix1 -> Sz1 -> e -> n ()) -> n () + let load :: Loader e load scheduler startAt dlWrite _dlSet = let loadIndex k ix = dlWrite (toLinearIndex newSz (insertDim' ix dim k) + startAt) arrayLoader !k arr = (k + 1) <$ scheduleWork scheduler (imapM_ (loadIndex k) arr) @@ -979,8 +977,7 @@ downsample stride arr = unsafeLinearWriteWithStride = unsafeIndex arr . liftIndex2 (*) strideIx . fromLinearIndex resultSize {-# INLINE unsafeLinearWriteWithStride #-} - load :: Monad m => - Scheduler m () -> Ix1 -> (Ix1 -> e -> m ()) -> (Ix1 -> Sz1 -> e -> m ()) -> m () + load :: Loader e load scheduler startAt dlWrite _ = splitLinearlyWithStartAtM_ scheduler @@ -1034,8 +1031,7 @@ upsample !fillWith safeStride arr = , dlLoad = load } where - load :: Monad m => - Scheduler m () -> Ix1 -> (Ix1 -> e -> m ()) -> (Ix1 -> Sz1 -> e -> m ()) -> m () + load :: Loader e load scheduler startAt uWrite uSet = do uSet startAt (toLinearSz newsz) fillWith loadArrayM scheduler arr (\i -> uWrite (adjustLinearStride (i + startAt))) @@ -1165,7 +1161,7 @@ zoomWithGrid gridVal (Stride zoomFactor) arr = unsafeMakeLoadArray Seq newSz (Ju !kx = liftIndex (+ 1) zoomFactor !lastNewIx = liftIndex2 (*) kx $ unSz (size arr) !newSz = Sz (liftIndex (+ 1) lastNewIx) - load :: Monad m => Scheduler m () -> Int -> (Int -> e -> m ()) -> m () + load :: forall s. Scheduler s () -> Ix1 -> (Ix1 -> e -> ST s ()) -> ST s () load scheduler _ writeElement = iforSchedulerM_ scheduler arr $ \ !ix !e -> let !kix = liftIndex2 (*) ix kx @@ -1217,7 +1213,7 @@ zoom (Stride zoomFactor) arr = unsafeMakeLoadArray Seq newSz Nothing load where !lastNewIx = liftIndex2 (*) zoomFactor $ unSz (size arr) !newSz = Sz lastNewIx - load :: Monad m => Scheduler m () -> Int -> (Int -> e -> m ()) -> m () + load :: forall s. Scheduler s () -> Ix1 -> (Ix1 -> e -> ST s ()) -> ST s () load scheduler _ writeElement = iforSchedulerM_ scheduler arr $ \ !ix !e -> let !kix = liftIndex2 (*) ix zoomFactor diff --git a/massiv/src/Data/Massiv/Core/Common.hs b/massiv/src/Data/Massiv/Core/Common.hs index 32265e96..6cdd3200 100644 --- a/massiv/src/Data/Massiv/Core/Common.hs +++ b/massiv/src/Data/Massiv/Core/Common.hs @@ -85,16 +85,17 @@ module Data.Massiv.Core.Common -- * Stateful Monads , runST , ST - , MonadUnliftIO + , MonadUnliftIO(..) , MonadIO(liftIO) , PrimMonad(PrimState) + , RealWorld ) where #if !MIN_VERSION_base(4,11,0) import Data.Semigroup #endif import Control.Monad.Catch (MonadThrow(..)) -import Control.Monad.IO.Unlift (MonadIO(liftIO), MonadUnliftIO) +import Control.Monad.IO.Unlift (MonadIO(liftIO), MonadUnliftIO(..)) import Control.Monad.Primitive import Control.Monad.ST import Control.Scheduler (Comp(..), Scheduler, WorkerStates, numWorkers, @@ -374,11 +375,10 @@ class (Strategy r, Shape r ix) => Load r ix e where -- -- @since 0.3.0 loadArrayM - :: Monad m => - Scheduler m () + :: Scheduler s () -> Array r ix e -- ^ Array that is being loaded - -> (Int -> e -> m ()) -- ^ Function that writes an element into target array - -> m () + -> (Int -> e -> ST s ()) -- ^ Function that writes an element into target array + -> ST s () loadArrayM scheduler arr uWrite = loadArrayWithSetM scheduler arr uWrite $ \offset sz e -> loopM_ offset (< (offset + unSz sz)) (+1) (`uWrite` e) @@ -390,13 +390,12 @@ class (Strategy r, Shape r ix) => Load r ix e where -- -- @since 0.5.8 loadArrayWithSetM - :: Monad m => - Scheduler m () + :: Scheduler s () -> Array r ix e -- ^ Array that is being loaded - -> (Ix1 -> e -> m ()) -- ^ Function that writes an element into target array - -> (Ix1 -> Sz1 -> e -> m ()) -- ^ Function that efficiently sets a region of an array - -- to the supplied value target array - -> m () + -> (Ix1 -> e -> ST s ()) -- ^ Function that writes an element into target array + -> (Ix1 -> Sz1 -> e -> ST s ()) -- ^ Function that efficiently sets a region of an array + -- to the supplied value target array + -> ST s () loadArrayWithSetM scheduler arr uWrite _ = loadArrayM scheduler arr uWrite {-# INLINE loadArrayWithSetM #-} @@ -406,10 +405,10 @@ class (Strategy r, Shape r ix) => Load r ix e where -- -- @since 0.5.7 unsafeLoadIntoS :: - (Mutable r' e, PrimMonad m) - => MVector (PrimState m) r' e + Mutable r' e + => MVector s r' e -> Array r ix e - -> m (MArray (PrimState m) r' ix e) + -> ST s (MArray s r' ix e) unsafeLoadIntoS marr arr = munsafeResize (outerSize arr) marr <$ loadArrayWithSetM trivialScheduler_ arr (unsafeLinearWrite marr) (unsafeLinearSet marr) @@ -419,20 +418,20 @@ class (Strategy r, Shape r ix) => Load r ix e where -- -- @since 0.5.7 unsafeLoadIntoM :: - (Mutable r' e, MonadIO m) + Mutable r' e => MVector RealWorld r' e -> Array r ix e - -> m (MArray RealWorld r' ix e) + -> IO (MArray RealWorld r' ix e) unsafeLoadIntoM marr arr = do - liftIO $ withMassivScheduler_ (getComp arr) $ \scheduler -> - loadArrayWithSetM scheduler arr (unsafeLinearWrite marr) (unsafeLinearSet marr) + withMassivScheduler_ (getComp arr) $ \scheduler -> + stToIO $ loadArrayWithSetM scheduler arr (unsafeLinearWrite marr) (unsafeLinearSet marr) pure $ munsafeResize (outerSize arr) marr {-# INLINE unsafeLoadIntoM #-} -- | Selects an optimal scheduler for the supplied strategy, but it works only in `IO` -- -- @since 1.0.0 -withMassivScheduler_ :: Comp -> (Scheduler IO () -> IO ()) -> IO () +withMassivScheduler_ :: Comp -> (Scheduler RealWorld () -> IO ()) -> IO () withMassivScheduler_ comp f = case comp of Par -> withGlobalScheduler_ globalScheduler f @@ -444,21 +443,20 @@ class (Size r, Load r ix e) => StrideLoad r ix e where -- | Load an array into memory with stride. Default implementation requires an instance of -- `Source`. loadArrayWithStrideM - :: Monad m => - Scheduler m () + :: Scheduler s () -> Stride ix -- ^ Stride to use -> Sz ix -- ^ Size of the target array affected by the stride. -> Array r ix e -- ^ Array that is being loaded - -> (Int -> e -> m ()) -- ^ Function that writes an element into target array - -> m () + -> (Int -> e -> ST s ()) -- ^ Function that writes an element into target array + -> ST s () default loadArrayWithStrideM - :: (Source r e, Monad m) => - Scheduler m () + :: Source r e => + Scheduler s () -> Stride ix -> Sz ix -> Array r ix e - -> (Int -> e -> m ()) - -> m () + -> (Int -> e -> ST s ()) + -> ST s () loadArrayWithStrideM scheduler stride resultSize arr = splitLinearlyWith_ scheduler (totalElem resultSize) unsafeLinearWriteWithStride where @@ -703,8 +701,8 @@ class (IsList (Array r ix e), Load r ix e) => Ragged r ix e where flattenRagged :: Array r ix e -> Vector r e - loadRagged :: Monad m => - Scheduler m () -> (Ix1 -> e -> m a) -> Ix1 -> Ix1 -> Sz ix -> Array r ix e -> m () + loadRagged :: + Scheduler s () -> (Ix1 -> e -> ST s a) -> Ix1 -> Ix1 -> Sz ix -> Array r ix e -> ST s () raggedFormat :: (e -> String) -> String -> Array r ix e -> String diff --git a/massiv/src/Data/Massiv/Core/Iterator.hs b/massiv/src/Data/Massiv/Core/Iterator.hs index d7bb1830..0df4b2b0 100644 --- a/massiv/src/Data/Massiv/Core/Iterator.hs +++ b/massiv/src/Data/Massiv/Core/Iterator.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE FlexibleContexts #-} -- | -- Module : Data.Massiv.Core.Iterator -- Copyright : (c) Alexey Kuleshevich 2018-2021 @@ -23,6 +24,8 @@ module Data.Massiv.Core.Iterator import Control.Scheduler import Control.Monad +import Control.Monad.Primitive +import Control.Monad.IO.Unlift -- | Efficient loop with an accumulator -- @@ -126,7 +129,7 @@ splitLinearly numChunks totalLength action = action chunkLength slackStart -- -- @since 0.5.7 splitLinearlyM_ :: - Monad m => Scheduler m () -> Int -> (Int -> Int -> m ()) -> m () + MonadPrimBase s m => Scheduler s () -> Int -> (Int -> Int -> m ()) -> m () splitLinearlyM_ scheduler totalLength action = splitLinearly (numWorkers scheduler) totalLength $ \chunkLength slackStart -> do loopNextM_ 0 (< slackStart) (+ chunkLength) $ \ start next -> @@ -140,7 +143,7 @@ splitLinearlyM_ scheduler totalLength action = -- -- @since 0.2.1 splitLinearlyWith_ :: - Monad m => Scheduler m () -> Int -> (Int -> b) -> (Int -> b -> m ()) -> m () + MonadPrimBase s m => Scheduler s () -> Int -> (Int -> b) -> (Int -> b -> m ()) -> m () splitLinearlyWith_ scheduler totalLength index = splitLinearlyWithM_ scheduler totalLength (pure . index) {-# INLINE splitLinearlyWith_ #-} @@ -150,7 +153,7 @@ splitLinearlyWith_ scheduler totalLength index = -- -- @since 0.2.6 splitLinearlyWithM_ :: - Monad m => Scheduler m () -> Int -> (Int -> m b) -> (Int -> b -> m c) -> m () + MonadPrimBase s m => Scheduler s () -> Int -> (Int -> m b) -> (Int -> b -> m c) -> m () splitLinearlyWithM_ scheduler totalLength make write = splitLinearlyM_ scheduler totalLength go where @@ -163,7 +166,7 @@ splitLinearlyWithM_ scheduler totalLength make write = -- -- @since 0.3.0 splitLinearlyWithStartAtM_ :: - Monad m => Scheduler m () -> Int -> Int -> (Int -> m b) -> (Int -> b -> m c) -> m () + MonadPrimBase s m => Scheduler s () -> Int -> Int -> (Int -> m b) -> (Int -> b -> m c) -> m () splitLinearlyWithStartAtM_ scheduler startAt totalLength make write = splitLinearly (numWorkers scheduler) totalLength $ \chunkLength slackStart -> do loopM_ startAt (< (slackStart + startAt)) (+ chunkLength) $ \ !start -> @@ -180,20 +183,21 @@ splitLinearlyWithStartAtM_ scheduler startAt totalLength make write = -- -- @since 0.3.4 splitLinearlyWithStatefulM_ :: - Monad m - => SchedulerWS s m () + MonadUnliftIO m + => SchedulerWS ws () -> Int -- ^ Total linear length - -> (Int -> s -> m b) -- ^ Element producing action + -> (Int -> ws -> m b) -- ^ Element producing action -> (Int -> b -> m c) -- ^ Element storing action -> m () splitLinearlyWithStatefulM_ schedulerWS totalLength make store = let nWorkers = numWorkers (unwrapSchedulerWS schedulerWS) - in splitLinearly nWorkers totalLength $ \chunkLength slackStart -> do + in withRunInIO $ \run -> + splitLinearly nWorkers totalLength $ \chunkLength slackStart -> do loopM_ 0 (< slackStart) (+ chunkLength) $ \ !start -> scheduleWorkState_ schedulerWS $ \s -> loopM_ start (< (start + chunkLength)) (+ 1) $ \ !k -> - make k s >>= store k + run (make k s >>= store k) scheduleWorkState_ schedulerWS $ \s -> loopM_ slackStart (< totalLength) (+ 1) $ \ !k -> - make k s >>= store k + run (make k s >>= store k) {-# INLINE splitLinearlyWithStatefulM_ #-} diff --git a/stack.yaml b/stack.yaml index 788a5db8..02070ffe 100644 --- a/stack.yaml +++ b/stack.yaml @@ -3,4 +3,8 @@ packages: - 'massiv/' - 'massiv-test/' flags: {} -extra-deps: [] +extra-deps: +- github: lehins/haskell-scheduler + commit: ad2c5383cbf8c1a7b840c99c7695efdd225c48d5 + subdirs: + - scheduler From 934678af43c3f907a552aa0aa8a3904455489b37 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sun, 18 Jul 2021 01:02:45 +0300 Subject: [PATCH 36/65] Take care of the warnings --- massiv/massiv.cabal | 4 ++-- massiv/src/Data/Massiv/Array/Ops/Construct.hs | 2 +- massiv/src/Data/Massiv/Array/Ops/Map.hs | 7 ++++--- massiv/src/Data/Massiv/Array/Ops/Sort.hs | 1 + massiv/src/Data/Massiv/Core/Iterator.hs | 1 + stack.yaml | 2 +- 6 files changed, 10 insertions(+), 7 deletions(-) diff --git a/massiv/massiv.cabal b/massiv/massiv.cabal index 858e365e..db2de770 100644 --- a/massiv/massiv.cabal +++ b/massiv/massiv.cabal @@ -81,8 +81,8 @@ library , bytestring , deepseq , exceptions - , scheduler >= 1.5.0 - , primitive + , scheduler >= 1.6.0 && < 2 + , primitive >= 0.7.1.0 , random >= 1.2.0 , unliftio-core , vector diff --git a/massiv/src/Data/Massiv/Array/Ops/Construct.hs b/massiv/src/Data/Massiv/Array/Ops/Construct.hs index 1cb5629c..30592d46 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Construct.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Construct.hs @@ -435,7 +435,7 @@ randomArrayS gen sz nextRandom = -- ] -- >>> randomArrayWS gens (Sz1 10) (uniformRM (0, 9)) :: IO (Vector P Int) -- Array P (ParN 3) (Sz1 10) --- [ 0, 9, 3, 2, 2, 7, 6, 7, 7, 5 ] +-- [ 0, 9, 3, 0, 8, 2, 8, 5, 0, 5 ] -- -- @since 0.3.4 randomArrayWS :: diff --git a/massiv/src/Data/Massiv/Array/Ops/Map.hs b/massiv/src/Data/Massiv/Array/Ops/Map.hs index f435efd4..0b89fc7e 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Map.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Map.hs @@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE MonoLocalBinds #-} -- | -- Module : Data.Massiv.Array.Ops.Map -- Copyright : (c) Alexey Kuleshevich 2018-2021 @@ -521,7 +522,7 @@ iforM_ = flip imapM_ -- -- @since 0.2.6 mapIO :: - forall r ix b r' a m. (Source r' a, Mutable r b, Index ix, MonadUnliftIO m, PrimMonad m) + forall r ix b r' a m. (Source r' a, Mutable r b, Index ix, MonadUnliftIO m) => (a -> m b) -> Array r' ix a -> m (Array r ix b) @@ -592,7 +593,7 @@ imapIO action arr = generateArray (getComp arr) (size arr) $ \ix -> action ix (u -- -- @since 0.2.6 forIO :: - forall r ix b r' a m. (Source r' a, Mutable r b, Index ix, MonadUnliftIO m, PrimMonad m) + forall r ix b r' a m. (Source r' a, Mutable r b, Index ix, MonadUnliftIO m) => Array r' ix a -> (a -> m b) -> m (Array r ix b) @@ -677,7 +678,7 @@ forIO_ = flip mapIO_ -- -- @since 0.2.6 iforIO :: - forall r ix b r' a m. (Source r' a, Mutable r b, Index ix, MonadUnliftIO m, PrimMonad m) + forall r ix b r' a m. (Source r' a, Mutable r b, Index ix, MonadUnliftIO m) => Array r' ix a -> (ix -> a -> m b) -> m (Array r ix b) diff --git a/massiv/src/Data/Massiv/Array/Ops/Sort.hs b/massiv/src/Data/Massiv/Array/Ops/Sort.hs index 8bc622fe..a6cb2e78 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Sort.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Sort.hs @@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MonoLocalBinds #-} -- | -- Module : Data.Massiv.Array.Ops.Sort -- Copyright : (c) Alexey Kuleshevich 2018-2021 diff --git a/massiv/src/Data/Massiv/Core/Iterator.hs b/massiv/src/Data/Massiv/Core/Iterator.hs index 0df4b2b0..23a05aa5 100644 --- a/massiv/src/Data/Massiv/Core/Iterator.hs +++ b/massiv/src/Data/Massiv/Core/Iterator.hs @@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MonoLocalBinds #-} -- | -- Module : Data.Massiv.Core.Iterator -- Copyright : (c) Alexey Kuleshevich 2018-2021 diff --git a/stack.yaml b/stack.yaml index 02070ffe..eec57239 100644 --- a/stack.yaml +++ b/stack.yaml @@ -5,6 +5,6 @@ packages: flags: {} extra-deps: - github: lehins/haskell-scheduler - commit: ad2c5383cbf8c1a7b840c99c7695efdd225c48d5 + commit: 46ac079867646452fd2bee98b7a70bbe69440f13 subdirs: - scheduler From 90e04d29c24971e1f89e41628205cba9c247a5c5 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Thu, 22 Jul 2021 04:14:33 +0300 Subject: [PATCH 37/65] Fixup some haddock links --- massiv-bench/stack-ghc-8.4.yaml | 9 ++--- massiv-bench/stack-ghc-8.6.yaml | 6 +++- massiv-bench/stack.yaml | 2 +- massiv-test/massiv-test.cabal | 2 +- massiv/CHANGELOG.md | 1 + massiv/massiv.cabal | 2 +- .../Data/Massiv/Array/Manifest/Internal.hs | 2 +- .../src/Data/Massiv/Array/Numeric/Integral.hs | 9 ++--- massiv/src/Data/Massiv/Array/Ops/Construct.hs | 29 +++++++++------- massiv/src/Data/Massiv/Core/Common.hs | 13 ++++---- massiv/src/Data/Massiv/Core/Exception.hs | 2 +- massiv/src/Data/Massiv/Core/Index.hs | 33 +++++++++++++++++-- massiv/src/Data/Massiv/Core/Index/Internal.hs | 32 ++++++++---------- massiv/src/Data/Massiv/Core/Index/Ix.hs | 33 +++---------------- massiv/src/Data/Massiv/Vector.hs | 2 +- stack-extra-deps.yaml | 7 ++-- stack.yaml | 2 +- 17 files changed, 97 insertions(+), 89 deletions(-) diff --git a/massiv-bench/stack-ghc-8.4.yaml b/massiv-bench/stack-ghc-8.4.yaml index c6745ad5..9c4ab64d 100644 --- a/massiv-bench/stack-ghc-8.4.yaml +++ b/massiv-bench/stack-ghc-8.4.yaml @@ -1,14 +1,9 @@ -resolver: lts-16.22 +resolver: lts-18.0 packages: - '.' extra-deps: - '../massiv/' -- pvar-1.0.0.0@sha256:3d4a6855b0960baee78f6956f082eb8aa1cede52d2955b7faef186d1133f7964,1893 -- primitive-0.7.1.0@sha256:6a237bb338bcc43193077ff8e8c0f0ce2de14c652231496a15672e8b563a07e2,2604 -#- scheduler-1.5.0@sha256:8b43f2991bf9a720b12192ba99525f705a44aeae9541a7bd73fbc7e7b56fd8f0,2437 -- random-1.2.0@sha256:4321209c8faedc034810ea8ed0dbc4a36f1a1df97b75af024219f2f533da57de,6094 -- splitmix-0.1.0.3 - github: lehins/haskell-scheduler - commit: ad2c5383cbf8c1a7b840c99c7695efdd225c48d5 + commit: c5506d20d96fc3fb00c213791243b7246d39e822 subdirs: - scheduler diff --git a/massiv-bench/stack-ghc-8.6.yaml b/massiv-bench/stack-ghc-8.6.yaml index 5fe2a777..51d18815 100644 --- a/massiv-bench/stack-ghc-8.6.yaml +++ b/massiv-bench/stack-ghc-8.6.yaml @@ -3,9 +3,13 @@ packages: - '.' extra-deps: - '../massiv/' -- scheduler-1.4.0@sha256:b182be9a7b84e1dba02dac761c3f4e204521d0f779d72d86040789d5aaadf92a,2833 +#- scheduler-1.4.0@sha256:b182be9a7b84e1dba02dac761c3f4e204521d0f779d72d86040789d5aaadf92a,2833 - github: lehins/dh-core commit: a24cd447718a23c9bb5732df5cfcc65bb91e5f2d subdirs: - dense-linear-algebra +- github: lehins/haskell-scheduler + commit: c5506d20d96fc3fb00c213791243b7246d39e822 + subdirs: + - scheduler allow-newer: true diff --git a/massiv-bench/stack.yaml b/massiv-bench/stack.yaml index c2209173..fb6ed20f 120000 --- a/massiv-bench/stack.yaml +++ b/massiv-bench/stack.yaml @@ -1 +1 @@ -stack-ghc-8.4.yaml \ No newline at end of file +stack-ghc-9.0.yaml \ No newline at end of file diff --git a/massiv-test/massiv-test.cabal b/massiv-test/massiv-test.cabal index 9194abda..023be51b 100644 --- a/massiv-test/massiv-test.cabal +++ b/massiv-test/massiv-test.cabal @@ -33,7 +33,7 @@ library , exceptions , QuickCheck , hspec - , massiv >= 0.6.1.0 + , massiv >= 1.0 && < 2 , scheduler , primitive , unliftio diff --git a/massiv/CHANGELOG.md b/massiv/CHANGELOG.md index 9d32f240..f3f9cb20 100644 --- a/massiv/CHANGELOG.md +++ b/massiv/CHANGELOG.md @@ -22,6 +22,7 @@ * Prevent `showsArrayPrec` from changing index type * Change function argument to monadic action for `unstablePartitionM` and `unsafeUnstablePartitionM` * Replace `snull` with a more generic `isNull` +* Switch `DL` loading function to run in `ST` monad, rather than in any `Monad m`. # 0.6.1 diff --git a/massiv/massiv.cabal b/massiv/massiv.cabal index db2de770..31bbd4bc 100644 --- a/massiv/massiv.cabal +++ b/massiv/massiv.cabal @@ -81,7 +81,7 @@ library , bytestring , deepseq , exceptions - , scheduler >= 1.6.0 && < 2 + , scheduler >= 2.0.0 && < 3.0.0 , primitive >= 0.7.1.0 , random >= 1.2.0 , unliftio-core diff --git a/massiv/src/Data/Massiv/Array/Manifest/Internal.hs b/massiv/src/Data/Massiv/Array/Manifest/Internal.hs index bf10d417..5cd93f47 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Internal.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Internal.hs @@ -230,7 +230,7 @@ fromRaggedArrayM arr = {-# INLINE fromRaggedArrayM #-} --- | Same as `fromRaggedArrayM`, but will throw a pure exception if its shape is not +-- | Same as `fromRaggedArrayM`, but will throw an impure exception if its shape is not -- rectangular. -- -- @since 0.1.1 diff --git a/massiv/src/Data/Massiv/Array/Numeric/Integral.hs b/massiv/src/Data/Massiv/Array/Numeric/Integral.hs index f1592a25..452bf280 100644 --- a/massiv/src/Data/Massiv/Array/Numeric/Integral.hs +++ b/massiv/src/Data/Massiv/Array/Numeric/Integral.hs @@ -260,8 +260,9 @@ fromFunctionMidpoint comp f a d (Sz sz) n = -- Approximation](http://tutorial.math.lamar.edu/Classes/CalcII/ApproximatingDefIntegrals.aspx), -- so if you need to brush up on some theory it is a great place to start. -- --- Implementation-wise, integral approximation here relies heavily on stencils with stride, as such --- computation is fast and is automatically parallelizable. +-- Implementation-wise, integral approximation here relies heavily on stencils +-- with stride, because such computation is fast and is automatically +-- parallelizable. -- -- Here are some examples of where this can be useful: -- @@ -323,8 +324,8 @@ fromFunctionMidpoint comp f a d (Sz sz) n = -- -- We can clearly see the difference is huge, but it doesn't mean it is much better than our -- previous estimate. In order to get more accurate results we can use a better Simpson's rule for --- approximation and many more sample points. There is no need to create individual arrays `xArr` --- and `yArr`, there are functions like `simpsonRule` that will take care it for you: +-- approximation and many more sample points. There is no need to create individual arrays @xArrX4@ +-- and @yArrX4@, there are functions like `simpsonsRule` that will take care of it for us: -- -- >>> simpsonsRule Seq U (\ scale i -> f (scale i)) startValue distPerCell desiredSize 128 -- Array D Seq (Sz1 4) diff --git a/massiv/src/Data/Massiv/Array/Ops/Construct.hs b/massiv/src/Data/Massiv/Array/Ops/Construct.hs index 30592d46..9a8cc101 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Construct.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Construct.hs @@ -292,9 +292,9 @@ iunfoldlS_ sz f acc0 = DLArray {dlComp = Seq, dlSize = sz, dlLoad = load} -- ] -- -- >>> import Data.Massiv.Array --- >>> import System.Random as System --- >>> gen = System.mkStdGen 217 --- >>> randomArray gen System.split System.random (ParN 2) (Sz2 2 3) :: Array DL Ix2 Double +-- >>> import System.Random as Random +-- >>> gen = Random.mkStdGen 217 +-- >>> randomArray gen Random.split Random.random (ParN 2) (Sz2 2 3) :: Array DL Ix2 Double -- Array DL (ParN 2) (Sz (2 :. 3)) -- [ [ 0.2616843941380331, 0.600959468331641, 0.4382415961606372 ] -- , [ 0.27812817813217605, 0.2993277194932741, 0.2774105268603957 ] @@ -420,22 +420,27 @@ randomArrayS gen sz nextRandom = -- [wmc-random](https://www.stackage.org/package/mwc-random), which is not thread safe, -- and safely parallelize it by giving each thread it's own generator. There is a caveat -- of course, statistical independence will depend on the entropy in your initial seeds, --- so do not use the example below verbatim, since intiial seeds are sequential numbers. +-- so do not use the example below verbatim, since initial seeds are sequential numbers. -- -- >>> import Data.Massiv.Array as A -- >>> import System.Random.MWC as MWC (initialize) -- >>> import System.Random.Stateful (uniformRM) -- >>> import Control.Scheduler (initWorkerStates, getWorkerId) -- >>> :set -XTypeApplications --- >>> gens <- initWorkerStates (ParN 3) (MWC.initialize . A.toPrimitiveVector . A.singleton @P @Ix1 . fromIntegral . getWorkerId) --- >>> randomArrayWS gens (Sz2 2 3) (uniformRM (0, 9)) :: IO (Array P Ix2 Double) --- Array P (ParN 3) (Sz (2 :. 3)) +-- >>> gens <- initWorkerStates Par (MWC.initialize . A.toPrimitiveVector . A.singleton @P @Ix1 . fromIntegral . getWorkerId) +-- >>> randomArrayWS gens (Sz2 2 3) (uniformRM (0, 9)) :: IO (Matrix P Double) +-- Array P Par (Sz (2 :. 3)) -- [ [ 2.5438514691269685, 4.287612444807011, 5.610339021582389 ] -- , [ 4.697970155404468, 5.00119167394813, 2.996037154611197 ] -- ] --- >>> randomArrayWS gens (Sz1 10) (uniformRM (0, 9)) :: IO (Vector P Int) --- Array P (ParN 3) (Sz1 10) --- [ 0, 9, 3, 0, 8, 2, 8, 5, 0, 5 ] +-- >>> randomArrayWS gens (Sz2 2 3) (uniformRM (0, 9)) :: IO (Matrix P Double) +-- Array P Par (Sz (2 :. 3)) +-- [ [ 2.3381558618288985, 5.950737336743302, 2.30528055886831 ] +-- , [ 6.537992271897603, 7.83182061304764, 4.17882094946732 ] +-- ] +-- >>> randomArrayWS gens (Sz1 6) (uniformRM (0, 9)) :: IO (Vector P Int) +-- Array P Par (Sz1 6) +-- [ 7, 6, 7, 7, 5, 3 ] -- -- @since 0.3.4 randomArrayWS :: @@ -548,7 +553,7 @@ rangeInclusive comp ixFrom ixTo = {-# INLINE rangeInclusive #-} --- | Just like `rangeStep`, except the finish index is included. +-- | Just like `rangeStepM`, except the finish index is included. -- -- @since 0.3.0 rangeStepInclusiveM :: (MonadThrow m, Index ix) => Comp -> ix -> ix -> ix -> m (Array D ix ix) @@ -604,7 +609,7 @@ rangeStepSize comp !from !step !sz = -- __/Similar/__: -- -- [@Prelude.`Prelude.enumFromTo`@] Very similar to @[i .. i + n - 1]@, except that --- `senumFromN` is faster, but it only works for `Num` and not for `Enum` elements +-- `enumFromN` is faster, but it only works for `Num` and not for `Enum` elements -- -- [@Data.Vector.Generic.`Data.Vector.Generic.enumFromN`@] -- diff --git a/massiv/src/Data/Massiv/Core/Common.hs b/massiv/src/Data/Massiv/Core/Common.hs index 6cdd3200..4d265f5e 100644 --- a/massiv/src/Data/Massiv/Core/Common.hs +++ b/massiv/src/Data/Massiv/Core/Common.hs @@ -115,9 +115,9 @@ import Data.Vector.Fusion.Util -- | The array family. Representations @r@ describe how data is arranged or computed. All -- arrays have a common property that each index @ix@ always maps to the same unique --- element, even if that element does not yet exist in memory and the arry has to be +-- element @e@, even if that element does not yet exist in memory and the array has to be -- computed in order to get access to that element. Data is always arranged in a nested --- row-major fashion, depth of which is controlled by @`Rank` ix@. +-- row-major fashion. Rank of an array is specified by @`Dimensions` ix@. data family Array r ix e :: Type -- | Type synonym for a single dimension array, or simply a flat vector. @@ -262,9 +262,10 @@ lengthHintUpperBound = \case class Size r where - -- | Get the exact size of an immutabe array. Most of the time will produce the size in - -- constant time, except for `DS` representation, which could result in evaluation of - -- the whole stream. See `maxLinearSize` and `Data.Massiv.Vector.slength` for more info. + -- | Get the exact size of an immutabe array. Most of the time will produce + -- the size in constant time, except for `Data.Massiv.Array.DS` + -- representation, which could result in evaluation of the whole stream. See + -- `maxLinearSize` and `Data.Massiv.Vector.slength` for more info. -- -- @since 0.1.0 size :: Array r ix e -> Sz ix @@ -328,7 +329,7 @@ class (Strategy r, Shape r ix) => Load r ix e where -- , [ 0, 0, 2, 0 ] -- ] -- - -- Instead of restricting the full type manually we can use `TypeApplications` as convenience: + -- Instead of restricting the full type manually we can use @TypeApplications@ as convenience: -- -- >>> :set -XTypeApplications -- >>> makeArray @P @_ @Double Seq (Sz2 3 4) $ \(i :. j) -> logBase (fromIntegral i) (fromIntegral j) diff --git a/massiv/src/Data/Massiv/Core/Exception.hs b/massiv/src/Data/Massiv/Core/Exception.hs index d0466293..2700f6e9 100644 --- a/massiv/src/Data/Massiv/Core/Exception.hs +++ b/massiv/src/Data/Massiv/Core/Exception.hs @@ -64,7 +64,7 @@ throwEither = {-# INLINE throwEither #-} -- | An error that gets thrown when an unitialized element of a boxed array gets accessed. Can only --- happen when array was constructed with `unsafeNew`. +-- happen when array was constructed with `Data.Massiv.Array.Unsafe.unsafeNew`. data Uninitialized = Uninitialized deriving Show instance Exception Uninitialized where diff --git a/massiv/src/Data/Massiv/Core/Index.hs b/massiv/src/Data/Massiv/Core/Index.hs index 7a96895c..cb46a202 100644 --- a/massiv/src/Data/Massiv/Core/Index.hs +++ b/massiv/src/Data/Massiv/Core/Index.hs @@ -110,6 +110,33 @@ import Data.Massiv.Core.Index.Tuple import Data.Massiv.Core.Iterator import GHC.TypeLits + +-- | 1-dimensional type synonym for size. +-- +-- @since 0.3.0 +type Sz1 = Sz Ix1 + +-- | 2-dimensional size type synonym. +-- +-- @since 0.3.0 +type Sz2 = Sz Ix2 + +-- | 3-dimensional size type synonym. +-- +-- @since 0.3.0 +type Sz3 = Sz Ix3 + +-- | 4-dimensional size type synonym. +-- +-- @since 0.3.0 +type Sz4 = Sz Ix4 + +-- | 5-dimensional size type synonym. +-- +-- @since 0.3.0 +type Sz5 = Sz Ix5 + + -- | Approach to be used near the borders during various transformations. -- Whenever a function needs information not only about an element of interest, but -- also about it's neighbors, it will go out of bounds near the array edges, @@ -340,9 +367,9 @@ modifyDim' ix dim = throwEither . modifyDimM ix dim -- -- ==== __Examples__ -- --- λ> dropDimM (2 :> 3 :> 4 :. 5) 3 :: Maybe Ix3 +-- >>> dropDimM (2 :> 3 :> 4 :. 5) 3 :: Maybe Ix3 -- Just (2 :> 4 :. 5) --- λ> dropDimM (2 :> 3 :> 4 :. 5) 6 :: Maybe Ix3 +-- >>> dropDimM (2 :> 3 :> 4 :. 5) 6 :: Maybe Ix3 -- Nothing -- -- @since 0.3.0 @@ -367,7 +394,7 @@ dropDim' ix = throwEither . dropDimM ix -- -- ==== __Examples__ -- --- λ> pullOutDim' (2 :> 3 :> 4 :. 5) 3 +-- >>> pullOutDim' (2 :> 3 :> 4 :. 5) 3 -- (3,2 :> 4 :. 5) -- -- @since 0.2.4 diff --git a/massiv/src/Data/Massiv/Core/Index/Internal.hs b/massiv/src/Data/Massiv/Core/Index/Internal.hs index ddd3ef59..dc6cef55 100644 --- a/massiv/src/Data/Massiv/Core/Index/Internal.hs +++ b/massiv/src/Data/Massiv/Core/Index/Internal.hs @@ -26,7 +26,6 @@ module Data.Massiv.Core.Index.Internal ( Sz(SafeSz) , pattern Sz , pattern Sz1 - , type Sz1 , unSz , zeroSz , oneSz @@ -71,11 +70,13 @@ import Data.Massiv.Core.Iterator import Data.Typeable import GHC.TypeLits --- | `Sz` is the size of the array. It describes total number of elements along each --- dimension in the array. It is a wrapper around an index of the same dimension, however --- it provides type safety preventing mixup with index. Moreover the @Sz@ constructor (and --- others `Sz1`, `Data.Massiv.Core.Index.Sz2`, ... that are specialized to specific --- dimensions prevent creation of invalid sizes with negative values. +-- | `Sz` is the size of the array. It describes total number of elements along +-- each dimension in the array. It is a wrapper around an index of the same +-- dimension, however it provides type safety preventing mixup with +-- index. Moreover the @Sz@ constructor and others such as +-- `Data.Massiv.Core.Index.Sz1`, `Data.Massiv.Core.Index.Sz2`, ... that +-- are specialized to specific dimensions, prevent creation of invalid sizes with +-- negative values by clamping them to zero. -- -- ====__Examples__ -- @@ -95,7 +96,7 @@ import GHC.TypeLits -- Sz (0 :> 0 :. 1) -- -- __Warning__: It is always wrong to `negate` a size, thus it will result in an --- error. For that reason also watch out for partially applied @(`-` sz)@, which is +-- error. For that reason also watch out for partially applied @(`Prelude.-` sz)@, which is -- deugared into @`negate` sz@. See more info about it in -- [#114](https://github.com/lehins/massiv/issues/114). -- @@ -117,15 +118,10 @@ pattern Sz ix <- SafeSz ix where Sz ix = SafeSz (liftIndex (max 0) ix) {-# COMPLETE Sz #-} --- | 1-dimensional type synonym for size. --- --- @since 0.3.0 -type Sz1 = Sz Ix1 - -- | 1-dimensional size constructor. Especially useful with literals: @(Sz1 5) == Sz (5 :: Int)@. -- -- @since 0.3.0 -pattern Sz1 :: Ix1 -> Sz1 +pattern Sz1 :: Ix1 -> Sz Ix1 pattern Sz1 ix <- SafeSz ix where Sz1 ix = SafeSz (max 0 ix) {-# COMPLETE Sz1 #-} @@ -251,7 +247,7 @@ liftSz2 f sz1 sz2 = Sz (liftIndex2 f (coerce sz1) (coerce sz2)) -- Sz (1 :> 2 :. 3) -- -- @since 0.3.0 -consSz :: Index ix => Sz1 -> Sz (Lower ix) -> Sz ix +consSz :: Index ix => Sz Ix1 -> Sz (Lower ix) -> Sz ix consSz (SafeSz i) (SafeSz ix) = SafeSz (consDim i ix) {-# INLINE consSz #-} @@ -265,7 +261,7 @@ consSz (SafeSz i) (SafeSz ix) = SafeSz (consDim i ix) -- Sz (2 :> 3 :. 1) -- -- @since 0.3.0 -snocSz :: Index ix => Sz (Lower ix) -> Sz1 -> Sz ix +snocSz :: Index ix => Sz (Lower ix) -> Sz Ix1 -> Sz ix snocSz (SafeSz i) (SafeSz ix) = SafeSz (snocDim i ix) {-# INLINE snocSz #-} @@ -308,7 +304,7 @@ insertSzM (SafeSz sz) dim (SafeSz sz1) = SafeSz <$> insertDimM sz dim sz1 -- (Sz1 1,Sz (2 :. 3)) -- -- @since 0.3.0 -unconsSz :: Index ix => Sz ix -> (Sz1, Sz (Lower ix)) +unconsSz :: Index ix => Sz ix -> (Sz Ix1, Sz (Lower ix)) unconsSz (SafeSz sz) = coerce (unconsDim sz) {-# INLINE unconsSz #-} @@ -321,7 +317,7 @@ unconsSz (SafeSz sz) = coerce (unconsDim sz) -- (Sz (1 :. 2),Sz1 3) -- -- @since 0.3.0 -unsnocSz :: Index ix => Sz ix -> (Sz (Lower ix), Sz1) +unsnocSz :: Index ix => Sz ix -> (Sz (Lower ix), Sz Ix1) unsnocSz (SafeSz sz) = coerce (unsnocDim sz) {-# INLINE unsnocSz #-} @@ -837,7 +833,7 @@ instance Show SizeException where -- -- @since 0.3.0 data ShapeException - = DimTooShortException !Sz1 !Sz1 + = DimTooShortException !(Sz Ix1) !(Sz Ix1) | DimTooLongException deriving Eq diff --git a/massiv/src/Data/Massiv/Core/Index/Ix.hs b/massiv/src/Data/Massiv/Core/Index/Ix.hs index b928154a..531f639e 100644 --- a/massiv/src/Data/Massiv/Core/Index/Ix.hs +++ b/massiv/src/Data/Massiv/Core/Index/Ix.hs @@ -25,22 +25,17 @@ module Data.Massiv.Core.Index.Ix , pattern Sz , type Ix1 , pattern Ix1 - , type Sz1 , pattern Sz1 , type Ix2(Ix2, (:.)) - , type Sz2 , pattern Sz2 , type Ix3 , pattern Ix3 - , type Sz3 , pattern Sz3 , type Ix4 , pattern Ix4 - , type Sz4 , pattern Sz4 , type Ix5 , pattern Ix5 - , type Sz5 , pattern Sz5 , HighIxN ) where @@ -73,15 +68,10 @@ pattern Ix2 :: Int -> Int -> Ix2 pattern Ix2 i2 i1 = i2 :. i1 {-# COMPLETE Ix2 #-} --- | 2-dimensional size type synonym. --- --- @since 0.3.0 -type Sz2 = Sz Ix2 - -- | 2-dimensional size constructor. @(Sz2 i j) == Sz (i :. j)@ -- -- @since 0.3.0 -pattern Sz2 :: Int -> Int -> Sz2 +pattern Sz2 :: Int -> Int -> Sz Ix2 pattern Sz2 i2 i1 = Sz (i2 :. i1) {-# COMPLETE Sz2 #-} @@ -98,15 +88,10 @@ pattern Ix3 :: Int -> Int -> Int -> Ix3 pattern Ix3 i3 i2 i1 = i3 :> i2 :. i1 {-# COMPLETE Ix3 #-} --- | 3-dimensional size type synonym. --- --- @since 0.3.0 -type Sz3 = Sz Ix3 - -- | 3-dimensional size constructor. @(Sz3 i j k) == Sz (i :> j :. k)@ -- -- @since 0.3.0 -pattern Sz3 :: Int -> Int -> Int -> Sz3 +pattern Sz3 :: Int -> Int -> Int -> Sz Ix3 pattern Sz3 i3 i2 i1 = Sz (i3 :> i2 :. i1) {-# COMPLETE Sz3 #-} @@ -122,15 +107,10 @@ pattern Ix4 :: Int -> Int -> Int -> Int -> Ix4 pattern Ix4 i4 i3 i2 i1 = i4 :> i3 :> i2 :. i1 {-# COMPLETE Ix4 #-} --- | 4-dimensional size type synonym. --- --- @since 0.3.0 -type Sz4 = Sz Ix4 - -- | 4-dimensional size constructor. @(Sz4 i j k l) == Sz (i :> j :> k :. l)@ -- -- @since 0.3.0 -pattern Sz4 :: Int -> Int -> Int -> Int -> Sz4 +pattern Sz4 :: Int -> Int -> Int -> Int -> Sz Ix4 pattern Sz4 i4 i3 i2 i1 = Sz (i4 :> i3 :> i2 :. i1) {-# COMPLETE Sz4 #-} @@ -146,15 +126,10 @@ pattern Ix5 :: Int -> Int -> Int -> Int -> Int -> Ix5 pattern Ix5 i5 i4 i3 i2 i1 = i5 :> i4 :> i3 :> i2 :. i1 {-# COMPLETE Ix5 #-} --- | 5-dimensional size type synonym. --- --- @since 0.3.0 -type Sz5 = Sz Ix5 - -- | 5-dimensional size constructor. @(Sz5 i j k l m) == Sz (i :> j :> k :> l :. m)@ -- -- @since 0.3.0 -pattern Sz5 :: Int -> Int -> Int -> Int -> Int -> Sz5 +pattern Sz5 :: Int -> Int -> Int -> Int -> Int -> Sz Ix5 pattern Sz5 i5 i4 i3 i2 i1 = Sz (i5 :> i4 :> i3 :> i2 :. i1) {-# COMPLETE Sz5 #-} diff --git a/massiv/src/Data/Massiv/Vector.hs b/massiv/src/Data/Massiv/Vector.hs index 5263e507..3d931230 100644 --- a/massiv/src/Data/Massiv/Vector.hs +++ b/massiv/src/Data/Massiv/Vector.hs @@ -1218,7 +1218,7 @@ sunfoldrExactNM n f = fromStepsM . S.unfoldrExactNM n f -- | /O(n)/ - Enumerate from a starting number @x@ exactly @n@ times with a step @1@. -- -- /Related/: `senumFromStepN`, `enumFromN`, `enumFromStepN`, `rangeSize`, --- `rangeStepSize`, `range`, `rangeStep` +-- `rangeStepSize`, `range`, `rangeStep'` -- -- ==== __Examples__ -- diff --git a/stack-extra-deps.yaml b/stack-extra-deps.yaml index a4b70fad..aa63674f 100644 --- a/stack-extra-deps.yaml +++ b/stack-extra-deps.yaml @@ -7,9 +7,8 @@ extra-deps: - unliftio-0.2.18@sha256:87fb541127d21939d3efc49ed9bc3df6eadc9eb06ffa7755fc857f62e15daf20,3395 - pvar-1.0.0.0@sha256:3d4a6855b0960baee78f6956f082eb8aa1cede52d2955b7faef186d1133f7964,1893 - primitive-0.7.1.0@sha256:6a237bb338bcc43193077ff8e8c0f0ce2de14c652231496a15672e8b563a07e2,2604 -- scheduler-1.5.0@sha256:8b43f2991bf9a720b12192ba99525f705a44aeae9541a7bd73fbc7e7b56fd8f0,2437 - vector-0.12.3.0@sha256:0ae2c1ba86f0077910be242ec6802cc3d7725fe7b2bea6987201aa3737b239b5,7953 -- random-1.2.0@sha256:5ca8674e95c46c7eb90f520c26aea22d403625c97697275434afba66ebd32b05,5897 +- random-1.2.0@sha256:195506fedaa7c31c1fa2a747e9b49b4a5d1f0b09dd8f1291f23a771656faeec3,6097 - mwc-random-0.15.0.1@sha256:48e4b01a7447671b8bd13957de65f19ef41ee0376083c0c501e179e68768276a,3372 - splitmix-0.1.0.3@sha256:fc3aae74c467f4b608050bef53aec17904a618731df9407e655d8f3bf8c32d5c,6049 @@ -18,3 +17,7 @@ extra-deps: - hspec-core-2.8.2@sha256:251d8d96d06078ee41c4350c707fbdb9235cbcac3d89ea4a4075f1715d7c3a8f,4955 - hspec-discover-2.8.2@sha256:e7d9f95303e3763114aa36b7f115bfa131ba490d8018c6468089b502dd208ec8,2183 - hspec-expectations-0.8.2@sha256:e2db24881baadc2d9d23b03cb629e80dcbda89a6b04ace9adb5f4d02ef8b31aa,1594 +- github: lehins/haskell-scheduler + commit: c5506d20d96fc3fb00c213791243b7246d39e822 + subdirs: + - scheduler diff --git a/stack.yaml b/stack.yaml index eec57239..57048297 100644 --- a/stack.yaml +++ b/stack.yaml @@ -5,6 +5,6 @@ packages: flags: {} extra-deps: - github: lehins/haskell-scheduler - commit: 46ac079867646452fd2bee98b7a70bbe69440f13 + commit: c5506d20d96fc3fb00c213791243b7246d39e822 subdirs: - scheduler From 99f162fb65c477f7a49f44012439ee61eee5e1f7 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sat, 24 Jul 2021 02:38:44 +0300 Subject: [PATCH 38/65] Bunch of mutable stuff and hie settings: * Rename `msize` -> `sizeOfMArray` * Add `unsafeResizeMArray` and `unsafeLinearSliceMArray` * Rename: * `loadArrayM` -> `iterArrayLinearM_` * `loadArrayWithSetM` -> `iterArrayLinearWithSetM_`. * `loadArrayWithStrideM` -> `iterArrayLinearWithStrideM_`. * Add `iterArrayLinearST_` and `iterArrayLinearWithSetST_` to `Load` class instead of `loadArrayM` and `loadArrayWithSetM`. * Add `iterArrayLinearWithStrideST_` to `LoadStride` class instead of `loadArrayWithStrideM`. * Add new mutable functions: * `resizeMArrayM`, * `outerSliceMArrayM` and `outerSlicesMArray`, * `for2PrimM_` and `ifor2PrimM_`, * `zipSwapM_` * Switch effectful mapping functions to use the representation specific iterators. Which means that they are now restricted to `Load` instead of `Source`. Functions affected: * `mapIO_`, `imapIO_`, `forIO_` and `iforIO_` * `mapIO`, `imapIO`, `forIO` and `iforIO` --- cabal.project | 5 - hie.yaml | 10 + massiv-bench/bench/Concat.hs | 2 +- massiv-bench/hie.yaml | 2 + massiv-bench/stack-ghc-8.8.yaml | 13 + massiv-bench/stack-ghc-9.0.yaml | 9 + massiv-test/src/Test/Massiv/Core/Mutable.hs | 2 +- massiv/CHANGELOG.md | 19 ++ .../Data/Massiv/Array/Delayed/Interleaved.hs | 8 +- massiv/src/Data/Massiv/Array/Delayed/Pull.hs | 5 +- massiv/src/Data/Massiv/Array/Delayed/Push.hs | 26 +- .../src/Data/Massiv/Array/Delayed/Stream.hs | 25 +- .../src/Data/Massiv/Array/Delayed/Windowed.hs | 28 +- .../src/Data/Massiv/Array/Manifest/Boxed.hs | 47 ++-- .../Data/Massiv/Array/Manifest/Internal.hs | 6 +- .../Data/Massiv/Array/Manifest/Primitive.hs | 15 +- .../Data/Massiv/Array/Manifest/Storable.hs | 16 +- .../src/Data/Massiv/Array/Manifest/Unboxed.hs | 16 +- massiv/src/Data/Massiv/Array/Mutable.hs | 243 +++++++++++++++--- .../Data/Massiv/Array/Mutable/Algorithms.hs | 2 +- .../src/Data/Massiv/Array/Mutable/Atomic.hs | 20 +- massiv/src/Data/Massiv/Array/Ops/Map.hs | 206 +++++++++++---- massiv/src/Data/Massiv/Array/Ops/Sort.hs | 2 +- massiv/src/Data/Massiv/Array/Ops/Transform.hs | 7 +- massiv/src/Data/Massiv/Array/Unsafe.hs | 33 ++- massiv/src/Data/Massiv/Core.hs | 2 +- massiv/src/Data/Massiv/Core/Common.hs | 145 ++++++----- massiv/src/Data/Massiv/Core/List.hs | 39 ++- massiv/src/Data/Massiv/Vector/Stream.hs | 2 +- shell.nix | 18 -- stack-extra-deps.yaml | 2 +- stack.yaml | 2 +- 32 files changed, 683 insertions(+), 294 deletions(-) delete mode 100644 cabal.project create mode 100644 hie.yaml create mode 100644 massiv-bench/hie.yaml create mode 100644 massiv-bench/stack-ghc-8.8.yaml create mode 100644 massiv-bench/stack-ghc-9.0.yaml delete mode 100644 shell.nix diff --git a/cabal.project b/cabal.project deleted file mode 100644 index bb393660..00000000 --- a/cabal.project +++ /dev/null @@ -1,5 +0,0 @@ -packages: */*.cabal -optimization: 2 - -package massiv-bench - benchmarks: True diff --git a/hie.yaml b/hie.yaml new file mode 100644 index 00000000..1ca7b53e --- /dev/null +++ b/hie.yaml @@ -0,0 +1,10 @@ +cradle: + stack: + #stackYaml: "./stack-extra-deps.yaml" + components: + - path: "./massiv/src" + component: "massiv:lib" + - path: "./massiv-test/src" + component: "massiv-test:lib" + - path: "./massiv-tests/tests" + component: "massiv-test:test:tests-O0" diff --git a/massiv-bench/bench/Concat.hs b/massiv-bench/bench/Concat.hs index c5beb795..40a32f56 100644 --- a/massiv-bench/bench/Concat.hs +++ b/massiv-bench/bench/Concat.hs @@ -63,7 +63,7 @@ concatMutableM arrsF = unsafeCreateArray_ (foldMap getComp arrsF) newSz $ \scheduler marr -> do let arrayLoader !offset arr = do scheduleWork scheduler $ do - stToIO $ loadArrayM scheduler arr (\i -> unsafeLinearWrite marr (i + offset)) + stToIO $ iterArrayLinearST scheduler arr (\i -> unsafeLinearWrite marr (i + offset)) pure (offset + totalElem (size arr)) foldM_ arrayLoader 0 $ a : arrs {-# INLINE concatMutableM #-} diff --git a/massiv-bench/hie.yaml b/massiv-bench/hie.yaml new file mode 100644 index 00000000..4ef275e0 --- /dev/null +++ b/massiv-bench/hie.yaml @@ -0,0 +1,2 @@ +cradle: + stack: diff --git a/massiv-bench/stack-ghc-8.8.yaml b/massiv-bench/stack-ghc-8.8.yaml new file mode 100644 index 00000000..c92a185e --- /dev/null +++ b/massiv-bench/stack-ghc-8.8.yaml @@ -0,0 +1,13 @@ +resolver: lts-16.22 +packages: +- '.' +extra-deps: +- '../massiv/' +- primitive-0.7.1.0@sha256:29de6bfd0cf8ba023ceb806203dfbec0e51e3524e75ffe41056f70b4229c6f0f,2728 +- random-1.2.0@sha256:195506fedaa7c31c1fa2a747e9b49b4a5d1f0b09dd8f1291f23a771656faeec3,6097 +- splitmix-0.1.0.3@sha256:fc3aae74c467f4b608050bef53aec17904a618731df9407e655d8f3bf8c32d5c,6049 +#- scheduler-1.4.0@sha256:b182be9a7b84e1dba02dac761c3f4e204521d0f779d72d86040789d5aaadf92a,2833 +- github: lehins/haskell-scheduler + commit: c5506d20d96fc3fb00c213791243b7246d39e822 + subdirs: + - scheduler diff --git a/massiv-bench/stack-ghc-9.0.yaml b/massiv-bench/stack-ghc-9.0.yaml new file mode 100644 index 00000000..3463a5dc --- /dev/null +++ b/massiv-bench/stack-ghc-9.0.yaml @@ -0,0 +1,9 @@ +resolver: lts-18.3 +packages: +- '.' +extra-deps: +- '../massiv/' +- github: lehins/haskell-scheduler + commit: c5506d20d96fc3fb00c213791243b7246d39e822 + subdirs: + - scheduler diff --git a/massiv-test/src/Test/Massiv/Core/Mutable.hs b/massiv-test/src/Test/Massiv/Core/Mutable.hs index fc61cda5..e83340fa 100644 --- a/massiv-test/src/Test/Massiv/Core/Mutable.hs +++ b/massiv-test/src/Test/Massiv/Core/Mutable.hs @@ -29,7 +29,7 @@ prop_UnsafeNewMsize :: => Property prop_UnsafeNewMsize = property $ \ sz -> do marr :: MArray RealWorld r ix e <- unsafeNew sz - sz `shouldBe` msize marr + sz `shouldBe` sizeOfMArray marr prop_UnsafeNewLinearWriteRead :: forall r ix e. diff --git a/massiv/CHANGELOG.md b/massiv/CHANGELOG.md index f3f9cb20..d0c4fb62 100644 --- a/massiv/CHANGELOG.md +++ b/massiv/CHANGELOG.md @@ -23,6 +23,25 @@ * Change function argument to monadic action for `unstablePartitionM` and `unsafeUnstablePartitionM` * Replace `snull` with a more generic `isNull` * Switch `DL` loading function to run in `ST` monad, rather than in any `Monad m`. +* Rename `msize` -> `sizeOfMArray` +* Add `unsafeResizeMArray` and `unsafeLinearSliceMArray` +* Rename: + * `loadArrayM` -> `iterArrayLinearM_` + * `loadArrayWithSetM` -> `iterArrayLinearWithSetM_`. + * `loadArrayWithStrideM` -> `iterArrayLinearWithStrideM_`. +* Add `iterArrayLinearST_` and `iterArrayLinearWithSetST_` to `Load` class instead + of `loadArrayM` and `loadArrayWithSetM`. +* Add `iterArrayLinearWithStrideST_` to `LoadStride` class instead of `loadArrayWithStrideM`. +* Add new mutable functions: + * `resizeMArrayM`, + * `outerSliceMArrayM` and `outerSlicesMArray`, + * `for2PrimM_` and `ifor2PrimM_`, + * `zipSwapM_` +* Switch effectful mapping functions to use the representation specific + iteration. Which means that they are now restricted to `Load` instead of + `Source`. Functions affected: + * `mapIO_`, `imapIO_`, `forIO_` and `iforIO_` + * `mapIO`, `imapIO`, `forIO` and `iforIO` # 0.6.1 diff --git a/massiv/src/Data/Massiv/Array/Delayed/Interleaved.hs b/massiv/src/Data/Massiv/Array/Delayed/Interleaved.hs index 22f84666..34c4ba09 100644 --- a/massiv/src/Data/Massiv/Array/Delayed/Interleaved.hs +++ b/massiv/src/Data/Massiv/Array/Delayed/Interleaved.hs @@ -59,21 +59,21 @@ instance Resize DI where instance Index ix => Load DI ix e where makeArray c sz = DIArray . makeArray c sz {-# INLINE makeArray #-} - loadArrayM scheduler (DIArray (DArray _ sz f)) uWrite = + iterArrayLinearST_ scheduler (DIArray (DArray _ sz f)) uWrite = loopM_ 0 (< numWorkers scheduler) (+ 1) $ \ !start -> scheduleWork scheduler $ iterLinearM_ sz start (totalElem sz) (numWorkers scheduler) (<) $ \ !k -> uWrite k . f - {-# INLINE loadArrayM #-} + {-# INLINE iterArrayLinearST_ #-} instance Index ix => StrideLoad DI ix e where - loadArrayWithStrideM scheduler stride resultSize arr uWrite = + iterArrayLinearWithStrideST_ scheduler stride resultSize arr uWrite = let strideIx = unStride stride DIArray (DArray _ _ f) = arr in loopM_ 0 (< numWorkers scheduler) (+ 1) $ \ !start -> scheduleWork scheduler $ iterLinearM_ resultSize start (totalElem resultSize) (numWorkers scheduler) (<) $ \ !i ix -> uWrite i (f (liftIndex2 (*) strideIx ix)) - {-# INLINE loadArrayWithStrideM #-} + {-# INLINE iterArrayLinearWithStrideST_ #-} -- | Convert a source array into an array that, when computed, will have its elemets evaluated out -- of order (interleaved amongst cores), hence making unbalanced computation better parallelizable. diff --git a/massiv/src/Data/Massiv/Array/Delayed/Pull.hs b/massiv/src/Data/Massiv/Array/Delayed/Pull.hs index f9d75d69..460fb1e4 100644 --- a/massiv/src/Data/Massiv/Array/Delayed/Pull.hs +++ b/massiv/src/Data/Massiv/Array/Delayed/Pull.hs @@ -159,8 +159,9 @@ instance Index ix => Foldable (Array D ix) where instance Index ix => Load D ix e where makeArray = DArray {-# INLINE makeArray #-} - loadArrayM !scheduler !arr = splitLinearlyWith_ scheduler (elemsCount arr) (unsafeLinearIndex arr) - {-# INLINE loadArrayM #-} + iterArrayLinearST_ !scheduler !arr = + splitLinearlyWith_ scheduler (elemsCount arr) (unsafeLinearIndex arr) + {-# INLINE iterArrayLinearST_ #-} instance Index ix => StrideLoad D ix e diff --git a/massiv/src/Data/Massiv/Array/Delayed/Push.hs b/massiv/src/Data/Massiv/Array/Delayed/Push.hs index 56eef074..d5db6a22 100644 --- a/massiv/src/Data/Massiv/Array/Delayed/Push.hs +++ b/massiv/src/Data/Massiv/Array/Delayed/Push.hs @@ -42,22 +42,18 @@ import Prelude hiding (map, zipWith) -- | Delayed load representation. Also known as Push array. data DL = DL deriving Show -type Loader e - = forall s. Scheduler s () - -> Ix1 - -> (Ix1 -> e -> ST s ()) - -> (Ix1 -> Sz1 -> e -> ST s ()) - -> ST s () +type Loader e = + forall s. Scheduler s () -- ^ Scheduler that will be used for loading + -> Ix1 -- ^ Start loading at this linear index + -> (Ix1 -> e -> ST s ()) -- ^ Linear element writing action + -> (Ix1 -> Sz1 -> e -> ST s ()) -- ^ Linear region setting action + -> ST s () data instance Array DL ix e = DLArray { dlComp :: !Comp , dlSize :: !(Sz ix) - , dlLoad :: forall s. Scheduler s () - -> Ix1 -- start loading at this linear index - -> (Ix1 -> e -> ST s ()) -- linear element writing action - -> (Ix1 -> Sz1 -> e -> ST s ()) -- linear region setting action - -> ST s () + , dlLoad :: Loader e } instance Strategy DL where @@ -294,7 +290,7 @@ toLoadArray arr = DLArray (getComp arr) sz load load :: forall s. Scheduler s () -> Ix1 -> (Ix1 -> e -> ST s ()) -> (Ix1 -> Sz1 -> e -> ST s ()) -> ST s () load scheduler !startAt dlWrite dlSet = - loadArrayWithSetM scheduler arr (dlWrite . (+ startAt)) (\offset -> dlSet (offset + startAt)) + iterArrayLinearWithSetST_ scheduler arr (dlWrite . (+ startAt)) (\offset -> dlSet (offset + startAt)) {-# INLINE load #-} {-# INLINE[1] toLoadArray #-} {-# RULES "toLoadArray/id" toLoadArray = id #-} @@ -313,7 +309,7 @@ fromStrideLoad stride arr = !newsz = strideSize stride (size arr) load :: Loader e load scheduler !startAt dlWrite _ = - loadArrayWithStrideM scheduler stride newsz arr (\ !i -> dlWrite (i + startAt)) + iterArrayLinearWithStrideST_ scheduler stride newsz arr (\ !i -> dlWrite (i + startAt)) {-# INLINE load #-} {-# INLINE fromStrideLoad #-} @@ -327,8 +323,8 @@ instance Index ix => Load DL ix e where {-# INLINE makeArrayLinear #-} replicate comp !sz !e = makeLoadArray comp sz e $ \_ _ -> pure () {-# INLINE replicate #-} - loadArrayWithSetM scheduler DLArray {dlLoad} = dlLoad scheduler 0 - {-# INLINE loadArrayWithSetM #-} + iterArrayLinearWithSetST_ scheduler DLArray {dlLoad} = dlLoad scheduler 0 + {-# INLINE iterArrayLinearWithSetST_ #-} instance Index ix => Functor (Array DL ix) where fmap f arr = arr {dlLoad = loadFunctor arr f} diff --git a/massiv/src/Data/Massiv/Array/Delayed/Stream.hs b/massiv/src/Data/Massiv/Array/Delayed/Stream.hs index ce1e171a..76222ad6 100644 --- a/massiv/src/Data/Massiv/Array/Delayed/Stream.hs +++ b/massiv/src/Data/Massiv/Array/Delayed/Stream.hs @@ -23,7 +23,6 @@ module Data.Massiv.Array.Delayed.Stream ) where import Control.Applicative -import Control.Monad (void) import Control.Monad.ST import Data.Coerce import Data.Foldable @@ -193,19 +192,19 @@ instance Load DS Ix1 e where replicate _ k = fromSteps . S.replicate k {-# INLINE replicate #-} - loadArrayM _scheduler arr uWrite = - case stepsSize (dsArray arr) of - LengthExact _ -> - void $ S.foldlM (\i e -> uWrite i e >> pure (i + 1)) 0 (S.transStepsId (coerce arr)) - _ -> error "Loading Stream array is not supported with loadArrayM" - {-# INLINE loadArrayM #-} + iterArrayLinearST_ _scheduler arr uWrite = + -- case stepsSize (dsArray arr) of + -- LengthExact _ -> + -- void $ S.foldlM (\i e -> uWrite i e >> pure (i + 1)) 0 (S.transStepsId (coerce arr)) + S.mapM_ (uncurry uWrite) $ S.indexed $ S.transStepsId (coerce arr) + {-# INLINE iterArrayLinearST_ #-} - unsafeLoadIntoS marr (DSArray sts) = + unsafeLoadIntoST marr (DSArray sts) = S.unstreamIntoM marr (stepsSize sts) (stepsStream sts) - {-# INLINE unsafeLoadIntoS #-} + {-# INLINE unsafeLoadIntoST #-} - unsafeLoadIntoM marr arr = stToIO $ unsafeLoadIntoS marr arr - {-# INLINE unsafeLoadIntoM #-} + unsafeLoadIntoIO marr arr = stToIO $ unsafeLoadIntoST marr arr + {-# INLINE unsafeLoadIntoIO #-} -- cons :: e -> Array DS Ix1 e -> Array DS Ix1 e @@ -223,13 +222,13 @@ instance Load DS Ix1 e where -- TODO: skip the stride while loading -- instance StrideLoad DS Ix1 e where --- loadArrayWithStrideM scheduler stride resultSize arr uWrite = +-- iterArrayLinearWithStrideST_ scheduler stride resultSize arr uWrite = -- let strideIx = unStride stride -- DIArray (DArray _ _ f) = arr -- in loopM_ 0 (< numWorkers scheduler) (+ 1) $ \ !start -> -- scheduleWork scheduler $ -- iterLinearM_ resultSize start (totalElem resultSize) (numWorkers scheduler) (<) $ -- \ !i ix -> uWrite i (f (liftIndex2 (*) strideIx ix)) --- {-# INLINE loadArrayWithStrideM #-} +-- {-# INLINE iterArrayLinearWithStrideST_ #-} diff --git a/massiv/src/Data/Massiv/Array/Delayed/Windowed.hs b/massiv/src/Data/Massiv/Array/Delayed/Windowed.hs index ac6431eb..cbc13b6f 100644 --- a/massiv/src/Data/Massiv/Array/Delayed/Windowed.hs +++ b/massiv/src/Data/Massiv/Array/Delayed/Windowed.hs @@ -217,7 +217,7 @@ instance Size DW where instance Load DW Ix1 e where makeArray c sz f = DWArray (makeArray c sz f) Nothing {-# INLINE makeArray #-} - loadArrayM scheduler arr uWrite = do + iterArrayLinearST_ scheduler arr uWrite = do (loadWindow, wStart, wEnd) <- loadWithIx1 (scheduleWork scheduler) arr uWrite let (chunkWidth, slackWidth) = (wEnd - wStart) `quotRem` numWorkers scheduler loopM_ 0 (< numWorkers scheduler) (+ 1) $ \ !wid -> @@ -226,10 +226,10 @@ instance Load DW Ix1 e where when (slackWidth > 0) $ let !itSlack = numWorkers scheduler * chunkWidth + wStart in loadWindow itSlack (itSlack + slackWidth) - {-# INLINE loadArrayM #-} + {-# INLINE iterArrayLinearST_ #-} instance StrideLoad DW Ix1 e where - loadArrayWithStrideM scheduler stride sz arr uWrite = do + iterArrayLinearWithStrideST_ scheduler stride sz arr uWrite = do (loadWindow, (wStart, wEnd)) <- loadArrayWithIx1 (scheduleWork scheduler) arr stride sz uWrite let (chunkWidth, slackWidth) = (wEnd - wStart) `quotRem` numWorkers scheduler loopM_ 0 (< numWorkers scheduler) (+ 1) $ \ !wid -> @@ -238,7 +238,7 @@ instance StrideLoad DW Ix1 e where when (slackWidth > 0) $ let !itSlack = numWorkers scheduler * chunkWidth + wStart in loadWindow (itSlack, itSlack + slackWidth) - {-# INLINE loadArrayWithStrideM #-} + {-# INLINE iterArrayLinearWithStrideST_ #-} loadArrayWithIx1 :: (Monad m) @@ -339,27 +339,27 @@ loadWindowIx2 nWorkers loadWindow (it :. ib) = do instance Load DW Ix2 e where makeArray c sz f = DWArray (makeArray c sz f) Nothing {-# INLINE makeArray #-} - loadArrayM scheduler arr uWrite = + iterArrayLinearST_ scheduler arr uWrite = loadWithIx2 (scheduleWork scheduler) arr uWrite >>= uncurry (loadWindowIx2 (numWorkers scheduler)) - {-# INLINE loadArrayM #-} + {-# INLINE iterArrayLinearST_ #-} instance StrideLoad DW Ix2 e where - loadArrayWithStrideM scheduler stride sz arr uWrite = + iterArrayLinearWithStrideST_ scheduler stride sz arr uWrite = loadArrayWithIx2 (scheduleWork scheduler) arr stride sz uWrite >>= uncurry (loadWindowIx2 (numWorkers scheduler)) - {-# INLINE loadArrayWithStrideM #-} + {-# INLINE iterArrayLinearWithStrideST_ #-} instance (Index (IxN n), Load DW (Ix (n - 1)) e) => Load DW (IxN n) e where makeArray c sz f = DWArray (makeArray c sz f) Nothing {-# INLINE makeArray #-} - loadArrayM = loadWithIxN - {-# INLINE loadArrayM #-} + iterArrayLinearST_ = loadWithIxN + {-# INLINE iterArrayLinearST_ #-} instance (Index (IxN n), StrideLoad DW (Ix (n - 1)) e) => StrideLoad DW (IxN n) e where - loadArrayWithStrideM = loadArrayWithIxN - {-# INLINE loadArrayWithStrideM #-} + iterArrayLinearWithStrideST_ = loadArrayWithIxN + {-# INLINE iterArrayLinearWithStrideST_ #-} loadArrayWithIxN :: (Index ix, StrideLoad DW (Lower ix) e) @@ -391,7 +391,7 @@ loadArrayWithIxN scheduler stride szResult arr uWrite = do DWArray {dwArray = DArray Seq lowerSourceSize (indexBorder . consDim i), dwWindow = ($ i) <$> mw} loadLower mw !i = - loadArrayWithStrideM + iterArrayLinearWithStrideST_ scheduler (Stride lowerStrideIx) lowerSize @@ -434,7 +434,7 @@ loadWithIxN scheduler arr uWrite = do DWArray {dwArray = DArray Seq szL (indexBorder . consDim i), dwWindow = ($ i) <$> mw} loadLower mw !i = scheduleWork_ scheduler $ - loadArrayM scheduler (mkLowerArray mw i) (\k -> uWrite (k + pageElements * i)) + iterArrayLinearST_ scheduler (mkLowerArray mw i) (\k -> uWrite (k + pageElements * i)) {-# NOINLINE loadLower #-} loopM_ 0 (< headDim windowStart) (+ 1) (loadLower Nothing) loopM_ t (< headDim windowEnd) (+ 1) (loadLower (Just mkLowerWindow)) diff --git a/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs b/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs index 7e353267..c8faaf87 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs @@ -165,11 +165,14 @@ instance Manifest BL e where instance Mutable BL e where data MArray s BL ix e = MBLArray !(Sz ix) {-# UNPACK #-} !Int {-# UNPACK #-} !(A.MutableArray s e) - msize (MBLArray sz _ _) = sz - {-# INLINE msize #-} + sizeOfMArray (MBLArray sz _ _) = sz + {-# INLINE sizeOfMArray #-} - munsafeResize sz (MBLArray _ off marr) = MBLArray sz off marr - {-# INLINE munsafeResize #-} + unsafeResizeMArray sz (MBLArray _ off marr) = MBLArray sz off marr + {-# INLINE unsafeResizeMArray #-} + + unsafeLinearSliceMArray i k (MBLArray _ o a) = MBLArray k (i + o) a + {-# INLINE unsafeLinearSliceMArray #-} unsafeThaw (BLArray _ sz o a) = MBLArray sz o <$> A.unsafeThawArray a {-# INLINE unsafeThaw #-} @@ -211,8 +214,9 @@ instance Index ix => Load BL ix e where replicate comp sz e = runST (newMArray sz e >>= unsafeFreeze comp) {-# INLINE replicate #-} - loadArrayM !scheduler !arr = splitLinearlyWith_ scheduler (elemsCount arr) (unsafeLinearIndex arr) - {-# INLINE loadArrayM #-} + iterArrayLinearST_ !scheduler !arr = + splitLinearlyWith_ scheduler (elemsCount arr) (unsafeLinearIndex arr) + {-# INLINE iterArrayLinearST_ #-} instance Index ix => StrideLoad BL ix e @@ -343,11 +347,14 @@ instance Manifest B e where instance Mutable B e where newtype MArray s B ix e = MBArray (MArray s BL ix e) - msize = msize . coerce - {-# INLINE msize #-} + sizeOfMArray = sizeOfMArray . coerce + {-# INLINE sizeOfMArray #-} + + unsafeResizeMArray sz = MBArray . unsafeResizeMArray sz . coerce + {-# INLINE unsafeResizeMArray #-} - munsafeResize sz = MBArray . munsafeResize sz . coerce - {-# INLINE munsafeResize #-} + unsafeLinearSliceMArray i k = MBArray . unsafeLinearSliceMArray i k . coerce + {-# INLINE unsafeLinearSliceMArray #-} unsafeThaw arr = MBArray <$> unsafeThaw (coerce arr) {-# INLINE unsafeThaw #-} @@ -377,8 +384,8 @@ instance Index ix => Load B ix e where replicate comp sz e = runST (newMArray sz e >>= unsafeFreeze comp) {-# INLINE replicate #-} - loadArrayM scheduler = coerce (loadArrayM scheduler) - {-# INLINE loadArrayM #-} + iterArrayLinearST_ scheduler = coerce (iterArrayLinearST_ scheduler) + {-# INLINE iterArrayLinearST_ #-} instance Index ix => StrideLoad B ix e @@ -512,11 +519,14 @@ instance NFData e => Manifest BN e where instance NFData e => Mutable BN e where newtype MArray s BN ix e = MBNArray (MArray s BL ix e) - msize = msize . coerce - {-# INLINE msize #-} + sizeOfMArray = sizeOfMArray . coerce + {-# INLINE sizeOfMArray #-} + + unsafeResizeMArray sz = coerce . unsafeResizeMArray sz . coerce + {-# INLINE unsafeResizeMArray #-} - munsafeResize sz = coerce . munsafeResize sz . coerce - {-# INLINE munsafeResize #-} + unsafeLinearSliceMArray i k = MBNArray . unsafeLinearSliceMArray i k . coerce + {-# INLINE unsafeLinearSliceMArray #-} unsafeThaw arr = MBNArray <$> unsafeThaw (coerce arr) {-# INLINE unsafeThaw #-} @@ -544,8 +554,9 @@ instance (Index ix, NFData e) => Load BN ix e where {-# INLINE makeArrayLinear #-} replicate comp sz e = runST (newMArray sz e >>= unsafeFreeze comp) {-# INLINE replicate #-} - loadArrayM !scheduler !arr = splitLinearlyWith_ scheduler (elemsCount arr) (unsafeLinearIndex arr) - {-# INLINE loadArrayM #-} + iterArrayLinearST_ !scheduler !arr = + splitLinearlyWith_ scheduler (elemsCount arr) (unsafeLinearIndex arr) + {-# INLINE iterArrayLinearST_ #-} instance (Index ix, NFData e) => StrideLoad BN ix e diff --git a/massiv/src/Data/Massiv/Array/Manifest/Internal.hs b/massiv/src/Data/Massiv/Array/Manifest/Internal.hs index 5cd93f47..bf0d8cac 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Internal.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Internal.hs @@ -226,7 +226,7 @@ fromRaggedArrayM arr = marr <- unsafeNew sz traverse (\_ -> unsafeFreeze (getComp arr) marr) =<< try (withMassivScheduler_ (getComp arr) $ \scheduler -> - stToIO $ loadRagged scheduler (unsafeLinearWrite marr) 0 (totalElem sz) sz arr) + stToIO $ loadRaggedST scheduler arr (unsafeLinearWrite marr) 0 (totalElem sz) sz) {-# INLINE fromRaggedArrayM #-} @@ -257,7 +257,7 @@ computeWithStride stride !arr = unsafePerformIO $ do let !sz = strideSize stride (size arr) unsafeCreateArray_ (getComp arr) sz $ \scheduler marr -> - stToIO $ loadArrayWithStrideM scheduler stride sz arr (unsafeLinearWrite marr) + stToIO $ iterArrayLinearWithStrideST_ scheduler stride sz arr (unsafeLinearWrite marr) {-# INLINE computeWithStride #-} @@ -380,7 +380,7 @@ iterateLoop convergence iteration = go go !n !arr !loadArr !marr = do let !sz = size loadArr !k = totalElem sz - !mk = totalElem (msize marr) + !mk = totalElem (sizeOfMArray marr) !comp = getComp loadArr marr' <- if k == mk diff --git a/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs b/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs index dbec9125..9a84d427 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs @@ -146,11 +146,14 @@ instance Prim e => Manifest P e where instance Prim e => Mutable P e where data MArray s P ix e = MPArray !(Sz ix) {-# UNPACK #-} !Int {-# UNPACK #-} !(MutableByteArray s) - msize (MPArray sz _ _) = sz - {-# INLINE msize #-} + sizeOfMArray (MPArray sz _ _) = sz + {-# INLINE sizeOfMArray #-} - munsafeResize sz (MPArray _ off marr) = MPArray sz off marr - {-# INLINE munsafeResize #-} + unsafeResizeMArray sz (MPArray _ off marr) = MPArray sz off marr + {-# INLINE unsafeResizeMArray #-} + + unsafeLinearSliceMArray i k (MPArray _ o a) = MPArray k (i + o) a + {-# INLINE unsafeLinearSliceMArray #-} unsafeThaw (PArray _ sz o a) = MPArray sz o <$> unsafeThawByteArray a {-# INLINE unsafeThaw #-} @@ -210,9 +213,9 @@ instance (Prim e, Index ix) => Load P ix e where replicate comp !sz !e = runST (newMArray sz e >>= unsafeFreeze comp) {-# INLINE replicate #-} - loadArrayM !scheduler !arr = + iterArrayLinearST_ !scheduler !arr = splitLinearlyWith_ scheduler (elemsCount arr) (unsafeLinearIndex arr) - {-# INLINE loadArrayM #-} + {-# INLINE iterArrayLinearST_ #-} instance (Prim e, Index ix) => StrideLoad P ix e diff --git a/massiv/src/Data/Massiv/Array/Manifest/Storable.hs b/massiv/src/Data/Massiv/Array/Manifest/Storable.hs index 609e21a5..15b61298 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Storable.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Storable.hs @@ -132,11 +132,14 @@ instance Storable e => Manifest S e where instance Storable e => Mutable S e where data MArray s S ix e = MSArray !(Sz ix) !(VS.MVector s e) - msize (MSArray sz _) = sz - {-# INLINE msize #-} + sizeOfMArray (MSArray sz _) = sz + {-# INLINE sizeOfMArray #-} - munsafeResize sz (MSArray _ mvec) = MSArray sz mvec - {-# INLINE munsafeResize #-} + unsafeResizeMArray sz (MSArray _ mv) = MSArray sz mv + {-# INLINE unsafeResizeMArray #-} + + unsafeLinearSliceMArray i k (MSArray _ mv) = MSArray k $ MVS.unsafeSlice i (unSz k) mv + {-# INLINE unsafeLinearSliceMArray #-} unsafeThaw (SArray _ sz v) = MSArray sz <$> VS.unsafeThaw v {-# INLINE unsafeThaw #-} @@ -203,8 +206,9 @@ instance (Index ix, Storable e) => Load S ix e where replicate comp !sz !e = runST (newMArray sz e >>= unsafeFreeze comp) {-# INLINE replicate #-} - loadArrayM !scheduler !arr = splitLinearlyWith_ scheduler (elemsCount arr) (unsafeLinearIndex arr) - {-# INLINE loadArrayM #-} + iterArrayLinearST_ !scheduler !arr = + splitLinearlyWith_ scheduler (elemsCount arr) (unsafeLinearIndex arr) + {-# INLINE iterArrayLinearST_ #-} instance (Index ix, Storable e) => StrideLoad S ix e diff --git a/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs b/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs index 7c511edd..d4cc7de8 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs @@ -110,8 +110,9 @@ instance (Unbox e, Index ix) => Load U ix e where replicate comp !sz !e = runST (newMArray sz e >>= unsafeFreeze comp) {-# INLINE replicate #-} - loadArrayM !scheduler !arr = splitLinearlyWith_ scheduler (elemsCount arr) (unsafeLinearIndex arr) - {-# INLINE loadArrayM #-} + iterArrayLinearST_ !scheduler !arr = + splitLinearlyWith_ scheduler (elemsCount arr) (unsafeLinearIndex arr) + {-# INLINE iterArrayLinearST_ #-} instance (Unbox e, Index ix) => StrideLoad U ix e @@ -126,11 +127,14 @@ instance Unbox e => Manifest U e where instance Unbox e => Mutable U e where data MArray s U ix e = MUArray !(Sz ix) !(VU.MVector s e) - msize (MUArray sz _) = sz - {-# INLINE msize #-} + sizeOfMArray (MUArray sz _) = sz + {-# INLINE sizeOfMArray #-} - munsafeResize sz (MUArray _ mvec) = MUArray sz mvec - {-# INLINE munsafeResize #-} + unsafeResizeMArray sz (MUArray _ mv) = MUArray sz mv + {-# INLINE unsafeResizeMArray #-} + + unsafeLinearSliceMArray i k (MUArray _ mv) = MUArray k $ MVU.unsafeSlice i (unSz k) mv + {-# INLINE unsafeLinearSliceMArray #-} unsafeThaw (UArray _ sz v) = MUArray sz <$> VU.unsafeThaw v {-# INLINE unsafeThaw #-} diff --git a/massiv/src/Data/Massiv/Array/Mutable.hs b/massiv/src/Data/Massiv/Array/Mutable.hs index 9daf6092..1e98da65 100644 --- a/massiv/src/Data/Massiv/Array/Mutable.hs +++ b/massiv/src/Data/Massiv/Array/Mutable.hs @@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -14,7 +15,11 @@ -- module Data.Massiv.Array.Mutable ( -- ** Size - msize + sizeOfMArray + , msize + , resizeMArrayM + , outerSliceMArrayM + , outerSlicesMArray -- ** Element-wise mutation , read , readM @@ -29,6 +34,7 @@ module Data.Massiv.Array.Mutable , swap_ , swapM , swapM_ + , zipSwapM_ -- ** Operations on @MArray@ -- *** Immutable conversion , thaw @@ -73,6 +79,8 @@ module Data.Massiv.Array.Mutable , iforPrimM_ , iforLinearPrimM , iforLinearPrimM_ + , for2PrimM_ + , ifor2PrimM_ -- *** Modify , withMArray , withMArray_ @@ -106,8 +114,106 @@ import Control.Monad.Primitive import Control.Scheduler import Data.Massiv.Core.Common import Data.Massiv.Array.Mutable.Internal +import Data.Massiv.Array.Delayed.Pull (D) import Prelude hiding (mapM, read) +-- | /O(1)/ - Change the size of a mutable array. Throws +-- `SizeElementsMismatchException` if total number of elements does not match +-- the supplied array. +-- +-- @since 1.0.0 +resizeMArrayM :: + (Mutable r e, Index ix', Index ix, MonadThrow m) + => Sz ix' + -> MArray s r ix e + -> m (MArray s r ix' e) +resizeMArrayM sz marr = + unsafeResizeMArray sz marr <$ guardNumberOfElements (sizeOfMArray marr) sz + + +-- | /O(1)/ - Slice a mutable array from the outside, while reducing its +-- dimensionality by one. Same as `Data.Massiv.Array.!?>` operator, but for +-- mutable arrays. +-- +-- @since 1.0.0 +outerSliceMArrayM :: + forall r ix e m s. (MonadThrow m, Index (Lower ix), Index ix, Mutable r e) + => MArray s r ix e + -> Ix1 + -> m (MArray s r (Lower ix) e) +outerSliceMArrayM !marr !i = do + let (k, szL) = unconsSz (sizeOfMArray marr) + unless (isSafeIndex k i) $ throwM $ IndexOutOfBoundsException k i + pure $ unsafeResizeMArray szL $ unsafeLinearSliceMArray i (toLinearSz szL) marr +{-# INLINE outerSliceMArrayM #-} + +-- | /O(1)/ - Take all outer slices of a mutable array and construct a delayed +-- vector out of them. In other words it applies `outerSliceMArrayM` to each +-- outer index. Same as `Data.Massiv.Array.outerSlices` function, but for +-- mutable arrays. +-- +-- ====__Examples__ +-- +-- >>> arr <- resizeM (Sz2 4 7) $ makeArrayR P Seq (Sz1 28) (+10) +-- >>> arr +-- Array P Seq (Sz (4 :. 7)) +-- [ [ 10, 11, 12, 13, 14, 15, 16 ] +-- , [ 17, 18, 19, 20, 21, 22, 23 ] +-- , [ 24, 25, 26, 27, 28, 29, 30 ] +-- , [ 31, 32, 33, 34, 35, 36, 37 ] +-- ] +-- +-- Here we can see we can get individual rows from a mutable matrix +-- +-- >>> marr <- thawS arr +-- >>> import Control.Monad ((<=<)) +-- >>> mapIO_ (print <=< freezeS) $ outerSlicesMArray Seq marr +-- Array P Seq (Sz1 7) +-- [ 10, 11, 12, 13, 14, 15, 16 ] +-- Array P Seq (Sz1 7) +-- [ 17, 18, 19, 20, 21, 22, 23 ] +-- Array P Seq (Sz1 7) +-- [ 24, 25, 26, 27, 28, 29, 30 ] +-- Array P Seq (Sz1 7) +-- [ 31, 32, 33, 34, 35, 36, 37 ] +-- +-- For the sake of example what if our goal was to mutate array in such a way +-- that rows from the top half were swapped with the bottom half: +-- +-- >>> (top, bottom) <- splitAtM 1 2 $ outerSlicesMArray Seq marr +-- >>> mapIO_ (print <=< freezeS) top +-- Array P Seq (Sz1 7) +-- [ 10, 11, 12, 13, 14, 15, 16 ] +-- Array P Seq (Sz1 7) +-- [ 17, 18, 19, 20, 21, 22, 23 ] +-- >>> mapIO_ (print <=< freezeS) bottom +-- Array P Seq (Sz1 7) +-- [ 24, 25, 26, 27, 28, 29, 30 ] +-- Array P Seq (Sz1 7) +-- [ 31, 32, 33, 34, 35, 36, 37 ] +-- >>> szipWithM_ (zipSwapM_ 0) top bottom +-- >>> freezeS marr +-- Array P Seq (Sz (4 :. 7)) +-- [ [ 24, 25, 26, 27, 28, 29, 30 ] +-- , [ 31, 32, 33, 34, 35, 36, 37 ] +-- , [ 10, 11, 12, 13, 14, 15, 16 ] +-- , [ 17, 18, 19, 20, 21, 22, 23 ] +-- ] +-- +-- @since 1.0.0 +outerSlicesMArray :: + forall r ix e s. (Index (Lower ix), Index ix, Mutable r e) + => Comp + -> MArray s r ix e + -> Vector D (MArray s r (Lower ix) e) +outerSlicesMArray comp marr = + makeArray comp k (\i -> unsafeResizeMArray szL $ unsafeLinearSliceMArray (i * unSz kL) kL marr) + where + kL = toLinearSz szL + (k, szL) = unconsSz $ sizeOfMArray marr +{-# INLINE outerSlicesMArray #-} + + -- | /O(n)/ - Initialize a new mutable array. All elements will be set to some default value. For -- boxed arrays it will be a thunk with `Uninitialized` exception, while for others it will be -- simply zeros. @@ -224,7 +330,7 @@ freeze :: -> m (Array r ix e) freeze comp smarr = liftIO $ do - let sz = msize smarr + let sz = sizeOfMArray smarr totalLength = totalElem sz tmarr <- unsafeNew sz withMassivScheduler_ comp $ \scheduler -> @@ -248,7 +354,7 @@ freezeS :: => MArray (PrimState m) r ix e -> m (Array r ix e) freezeS smarr = do - let sz = msize smarr + let sz = sizeOfMArray smarr tmarr <- unsafeNew sz unsafeLinearCopy smarr 0 tmarr 0 (SafeSz (totalElem sz)) unsafeFreeze Seq tmarr @@ -268,7 +374,7 @@ loadArrayS :: -> m (MArray (PrimState m) r ix e) loadArrayS arr = do marr <- unsafeNewUpper arr - stToPrim $ unsafeLoadIntoS marr arr + stToPrim $ unsafeLoadIntoST marr arr {-# INLINE loadArrayS #-} @@ -282,7 +388,7 @@ loadArray :: loadArray arr = liftIO $ do marr <- unsafeNewUpper arr - unsafeLoadIntoM marr arr + unsafeLoadIntoIO marr arr {-# INLINE loadArray #-} @@ -298,10 +404,10 @@ computeInto :: -> m () computeInto !mArr !arr = liftIO $ do - unless (totalElem (msize mArr) == totalElem (size arr)) $ - throwM $ SizeElementsMismatchException (msize mArr) (size arr) + unless (totalElem (sizeOfMArray mArr) == totalElem (size arr)) $ + throwM $ SizeElementsMismatchException (sizeOfMArray mArr) (size arr) withMassivScheduler_ (getComp arr) $ \scheduler -> - stToPrim $ loadArrayM scheduler arr (unsafeLinearWrite mArr) + stToPrim $ iterArrayLinearST_ scheduler arr (unsafeLinearWrite mArr) {-# INLINE computeInto #-} @@ -327,7 +433,7 @@ makeMArrayLinearS :: -> m (MArray (PrimState m) r ix e) makeMArrayLinearS sz f = do marr <- unsafeNew sz - loopM_ 0 (< totalElem (msize marr)) (+ 1) (\ !i -> f i >>= unsafeLinearWrite marr i) + loopM_ 0 (< totalElem (sizeOfMArray marr)) (+ 1) (\ !i -> f i >>= unsafeLinearWrite marr i) return marr {-# INLINE makeMArrayLinearS #-} @@ -513,7 +619,7 @@ generateArrayLinearS :: -> m (Array r ix e) generateArrayLinearS sz gen = do marr <- unsafeNew sz - loopM_ 0 (< totalElem (msize marr)) (+ 1) $ \i -> gen i >>= unsafeLinearWrite marr i + loopM_ 0 (< totalElem (sizeOfMArray marr)) (+ 1) $ \i -> gen i >>= unsafeLinearWrite marr i unsafeFreeze Seq marr {-# INLINE generateArrayLinearS #-} @@ -635,7 +741,7 @@ iunfoldrPrimM :: -> m (a, Array r ix e) iunfoldrPrimM sz gen acc0 = unsafeCreateArrayS sz $ \marr -> - let sz' = msize marr + let sz' = sizeOfMArray marr in iterLinearM sz' 0 (totalElem sz') 1 (<) acc0 $ \ !i ix !acc -> do (e, acc') <- gen acc ix unsafeLinearWrite marr i e @@ -653,7 +759,7 @@ unfoldrPrimM :: -> m (a, Array r ix e) unfoldrPrimM sz gen acc0 = unsafeCreateArrayS sz $ \marr -> - let sz' = msize marr + let sz' = sizeOfMArray marr in loopM 0 (< totalElem sz') (+ 1) acc0 $ \ !i !acc -> do (e, acc') <- gen acc unsafeLinearWrite marr i e @@ -716,7 +822,7 @@ iunfoldlPrimM :: -> m (a, Array r ix e) iunfoldlPrimM sz gen acc0 = unsafeCreateArrayS sz $ \marr -> - let sz' = msize marr + let sz' = sizeOfMArray marr in iterLinearM sz' (totalElem sz' - 1) 0 (negate 1) (>=) acc0 $ \ !i ix !acc -> do (acc', e) <- gen acc ix unsafeLinearWrite marr i e @@ -734,7 +840,7 @@ unfoldlPrimM :: -> m (a, Array r ix e) unfoldlPrimM sz gen acc0 = unsafeCreateArrayS sz $ \marr -> - let sz' = msize marr + let sz' = sizeOfMArray marr in loopDeepM 0 (< totalElem sz') (+1) acc0 $ \ !i !acc -> do (acc', e) <- gen acc unsafeLinearWrite marr i e @@ -747,7 +853,7 @@ unfoldlPrimM sz gen acc0 = -- @since 0.4.0 forPrimM_ :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (e -> m ()) -> m () forPrimM_ marr f = - loopM_ 0 (< totalElem (msize marr)) (+1) (unsafeLinearRead marr >=> f) + loopM_ 0 (< totalElem (sizeOfMArray marr)) (+1) (unsafeLinearRead marr >=> f) {-# INLINE forPrimM_ #-} -- | Sequentially loop over a mutable array while modifying each element with an action. @@ -755,7 +861,7 @@ forPrimM_ marr f = -- @since 0.4.0 forPrimM :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (e -> m e) -> m () forPrimM marr f = - loopM_ 0 (< totalElem (msize marr)) (+1) (unsafeLinearModify marr f) + loopM_ 0 (< totalElem (sizeOfMArray marr)) (+1) (unsafeLinearModify marr f) {-# INLINE forPrimM #-} @@ -766,7 +872,7 @@ forPrimM marr f = -- @since 0.4.0 iforPrimM_ :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (ix -> e -> m ()) -> m () -iforPrimM_ marr f = iforLinearPrimM_ marr (f . fromLinearIndex (msize marr)) +iforPrimM_ marr f = iforLinearPrimM_ marr (f . fromLinearIndex (sizeOfMArray marr)) {-# INLINE iforPrimM_ #-} -- | Sequentially loop over a mutable array while modifying each element with an index aware action. @@ -774,7 +880,7 @@ iforPrimM_ marr f = iforLinearPrimM_ marr (f . fromLinearIndex (msize marr)) -- @since 0.4.0 iforPrimM :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (ix -> e -> m e) -> m () -iforPrimM marr f = iforLinearPrimM marr (f . fromLinearIndex (msize marr)) +iforPrimM marr f = iforLinearPrimM marr (f . fromLinearIndex (sizeOfMArray marr)) {-# INLINE iforPrimM #-} @@ -786,7 +892,7 @@ iforPrimM marr f = iforLinearPrimM marr (f . fromLinearIndex (msize marr)) iforLinearPrimM_ :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (Int -> e -> m ()) -> m () iforLinearPrimM_ marr f = - loopM_ 0 (< totalElem (msize marr)) (+ 1) (\i -> unsafeLinearRead marr i >>= f i) + loopM_ 0 (< totalElem (sizeOfMArray marr)) (+ 1) (\i -> unsafeLinearRead marr i >>= f i) {-# INLINE iforLinearPrimM_ #-} -- | Sequentially loop over a mutable array while modifying each element with an index aware action. @@ -795,9 +901,43 @@ iforLinearPrimM_ marr f = iforLinearPrimM :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (Int -> e -> m e) -> m () iforLinearPrimM marr f = - loopM_ 0 (< totalElem (msize marr)) (+ 1) (\i -> unsafeLinearModify marr (f i) i) + loopM_ 0 (< totalElem (sizeOfMArray marr)) (+ 1) (\i -> unsafeLinearModify marr (f i) i) {-# INLINE iforLinearPrimM #-} + + +-- | Sequentially loop over the intersection of two mutable arrays while reading +-- elements from both and applying an action to it. There is no mutation to the +-- actual arrays, unless the action itself modifies either one of them. +-- +-- @since 1.0.0 +for2PrimM_ :: + forall r1 r2 e1 e2 ix m. (PrimMonad m, Index ix, Mutable r1 e1, Mutable r2 e2) + => MArray (PrimState m) r1 ix e1 + -> MArray (PrimState m) r2 ix e2 + -> (e1 -> e2 -> m ()) + -> m () +for2PrimM_ m1 m2 f = ifor2PrimM_ m1 m2 (const f) +{-# INLINE for2PrimM_ #-} + +-- | Same as `for2PrimM_`, but with index aware action. +-- +-- @since 1.0.0 +ifor2PrimM_ :: + forall r1 r2 e1 e2 ix m. (PrimMonad m, Index ix, Mutable r1 e1, Mutable r2 e2) + => MArray (PrimState m) r1 ix e1 + -> MArray (PrimState m) r2 ix e2 + -> (ix -> e1 -> e2 -> m ()) + -> m () +ifor2PrimM_ m1 m2 f = do + let sz = liftIndex2 min (unSz (sizeOfMArray m1)) (unSz (sizeOfMArray m2)) + iterM_ zeroIndex sz oneIndex (<) $ \ix -> do + e1 <- unsafeRead m1 ix + e2 <- unsafeRead m2 ix + f ix e1 e2 +{-# INLINE ifor2PrimM_ #-} + + -- | Same as `withMArray_`, but allows to keep artifacts of scheduled tasks. -- -- @since 0.5.0 @@ -963,7 +1103,7 @@ withLoadMArrayST_ arr f = runST $ withLoadMArrayS_ arr f read :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> m (Maybe e) read marr ix = - if isSafeIndex (msize marr) ix + if isSafeIndex (sizeOfMArray marr) ix then Just <$> unsafeRead marr ix else return Nothing {-# INLINE read #-} @@ -977,7 +1117,7 @@ readM :: (Mutable r e, Index ix, PrimMonad m, MonadThrow m) => readM marr ix = read marr ix >>= \case Just e -> pure e - Nothing -> throwM $ IndexOutOfBoundsException (msize marr) ix + Nothing -> throwM $ IndexOutOfBoundsException (sizeOfMArray marr) ix {-# INLINE readM #-} @@ -987,7 +1127,7 @@ readM marr ix = -- @since 0.1.0 write :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> e -> m Bool write marr ix e = - if isSafeIndex (msize marr) ix + if isSafeIndex (sizeOfMArray marr) ix then unsafeWrite marr ix e >> pure True else pure False {-# INLINE write #-} @@ -999,7 +1139,7 @@ write marr ix e = -- -- @since 0.4.4 write_ :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> e -> m () -write_ marr ix = when (isSafeIndex (msize marr) ix) . unsafeWrite marr ix +write_ marr ix = when (isSafeIndex (sizeOfMArray marr) ix) . unsafeWrite marr ix {-# INLINE write_ #-} -- | /O(1)/ - Same as `write`, but throws `IndexOutOfBoundsException` on an invalid index. @@ -1008,7 +1148,7 @@ write_ marr ix = when (isSafeIndex (msize marr) ix) . unsafeWrite marr ix writeM :: (Mutable r e, Index ix, PrimMonad m, MonadThrow m) => MArray (PrimState m) r ix e -> ix -> e -> m () writeM marr ix e = - write marr ix e >>= (`unless` throwM (IndexOutOfBoundsException (msize marr) ix)) + write marr ix e >>= (`unless` throwM (IndexOutOfBoundsException (sizeOfMArray marr) ix)) {-# INLINE writeM #-} @@ -1023,7 +1163,7 @@ modify :: -> ix -- ^ Index at which to perform modification. -> m (Maybe e) modify marr f ix = - if isSafeIndex (msize marr) ix + if isSafeIndex (sizeOfMArray marr) ix then Just <$> unsafeModify marr f ix else return Nothing {-# INLINE modify #-} @@ -1039,7 +1179,7 @@ modify_ :: -> (e -> m e) -- ^ Monadic action that modifies the element -> ix -- ^ Index at which to perform modification. -> m () -modify_ marr f ix = when (isSafeIndex (msize marr) ix) $ void $ unsafeModify marr f ix +modify_ marr f ix = when (isSafeIndex (sizeOfMArray marr) ix) $ void $ unsafeModify marr f ix {-# INLINE modify_ #-} -- | /O(1)/ - Modify an element in the cell of a mutable array with a supplied @@ -1054,8 +1194,8 @@ modifyM :: -> ix -- ^ Index at which to perform modification. -> m e modifyM marr f ix - | isSafeIndex (msize marr) ix = unsafeModify marr f ix - | otherwise = throwM (IndexOutOfBoundsException (msize marr) ix) + | isSafeIndex (sizeOfMArray marr) ix = unsafeModify marr f ix + | otherwise = throwM (IndexOutOfBoundsException (sizeOfMArray marr) ix) {-# INLINE modifyM #-} -- | /O(1)/ - Same as `modifyM`, but discard the returned element @@ -1087,7 +1227,7 @@ modifyM_ marr f ix = void $ modifyM marr f ix -- @since 0.1.0 swap :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> ix -> m (Maybe (e, e)) swap marr ix1 ix2 = - let !sz = msize marr + let !sz = sizeOfMArray marr in if isSafeIndex sz ix1 && isSafeIndex sz ix2 then Just <$> unsafeSwap marr ix1 ix2 else pure Nothing @@ -1100,7 +1240,7 @@ swap marr ix1 ix2 = -- @since 0.4.4 swap_ :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> ix -> m () swap_ marr ix1 ix2 = - let !sz = msize marr + let !sz = sizeOfMArray marr in when (isSafeIndex sz ix1 && isSafeIndex sz ix2) $ void $ unsafeSwap marr ix1 ix2 {-# INLINE swap_ #-} @@ -1118,11 +1258,11 @@ swapM :: -- the tuple. -> m (e, e) swapM marr ix1 ix2 - | not (isSafeIndex sz ix1) = throwM $ IndexOutOfBoundsException (msize marr) ix1 - | not (isSafeIndex sz ix2) = throwM $ IndexOutOfBoundsException (msize marr) ix2 + | not (isSafeIndex sz ix1) = throwM $ IndexOutOfBoundsException (sizeOfMArray marr) ix1 + | not (isSafeIndex sz ix2) = throwM $ IndexOutOfBoundsException (sizeOfMArray marr) ix2 | otherwise = unsafeSwap marr ix1 ix2 where - !sz = msize marr + !sz = sizeOfMArray marr {-# INLINE swapM #-} @@ -1130,7 +1270,40 @@ swapM marr ix1 ix2 -- -- @since 0.4.0 swapM_ :: - (Mutable r e, Index ix, PrimMonad m, MonadThrow m) => MArray (PrimState m) r ix e -> ix -> ix -> m () + (Mutable r e, Index ix, PrimMonad m, MonadThrow m) + => MArray (PrimState m) r ix e + -> ix + -> ix + -> m () swapM_ marr ix1 ix2 = void $ swapM marr ix1 ix2 {-# INLINE swapM_ #-} +-- | Swap elements in the intersection of two mutable arrays starting at the +-- initial index. +-- +-- @since 1.0.0 +zipSwapM_ :: + forall r1 r2 ix e m s. (MonadPrim s m, Mutable r2 e, Mutable r1 e, Index ix) + => ix + -> MArray s r1 ix e + -> MArray s r2 ix e + -> m () +zipSwapM_ startIx m1 m2 = do + let sz1 = sizeOfMArray m1 + sz2 = sizeOfMArray m2 + sz = liftIndex2 min (unSz sz1) (unSz sz2) + iterM_ startIx sz oneIndex (<) $ \ix -> do + let i1 = toLinearIndex sz1 ix + i2 = toLinearIndex sz2 ix + e1 <- unsafeLinearRead m1 i1 + e2 <- unsafeLinearRead m2 i2 + unsafeLinearWrite m2 i2 e1 + unsafeLinearWrite m1 i1 e2 +{-# INLINE zipSwapM_ #-} + +-- | Get the size of a mutable array. +-- +-- @since 0.1.0 +msize :: (Mutable r e, Index ix) => MArray s r ix e -> Sz ix +msize = sizeOfMArray +{-# DEPRECATED msize "In favor of `sizeOfMArray`" #-} diff --git a/massiv/src/Data/Massiv/Array/Mutable/Algorithms.hs b/massiv/src/Data/Massiv/Array/Mutable/Algorithms.hs index 6cc4ce20..7d6c26a8 100644 --- a/massiv/src/Data/Massiv/Array/Mutable/Algorithms.hs +++ b/massiv/src/Data/Massiv/Array/Mutable/Algorithms.hs @@ -40,4 +40,4 @@ unstablePartitionM :: => MVector (PrimState m) r e -> (e -> m Bool) -- ^ Predicate -> m Ix1 -unstablePartitionM marr f = unsafeUnstablePartitionRegionM marr f 0 (unSz (msize marr) - 1) +unstablePartitionM marr f = unsafeUnstablePartitionRegionM marr f 0 (unSz (sizeOfMArray marr) - 1) diff --git a/massiv/src/Data/Massiv/Array/Mutable/Atomic.hs b/massiv/src/Data/Massiv/Array/Mutable/Atomic.hs index c04d6ee6..816f4d9a 100644 --- a/massiv/src/Data/Massiv/Array/Mutable/Atomic.hs +++ b/massiv/src/Data/Massiv/Array/Mutable/Atomic.hs @@ -37,7 +37,7 @@ import Data.Massiv.Core.Common atomicReadIntArray :: (Index ix, PrimMonad m) => MArray (PrimState m) P ix Int -> ix -> m (Maybe Int) atomicReadIntArray marr ix - | isSafeIndex (msize marr) ix = Just <$> unsafeAtomicReadIntArray marr ix + | isSafeIndex (sizeOfMArray marr) ix = Just <$> unsafeAtomicReadIntArray marr ix | otherwise = pure Nothing {-# INLINE atomicReadIntArray #-} @@ -49,7 +49,7 @@ atomicReadIntArray marr ix atomicWriteIntArray :: (Index ix, PrimMonad m) => MArray (PrimState m) P ix Int -> ix -> Int -> m Bool atomicWriteIntArray marr ix f - | isSafeIndex (msize marr) ix = unsafeAtomicWriteIntArray marr ix f >> pure True + | isSafeIndex (sizeOfMArray marr) ix = unsafeAtomicWriteIntArray marr ix f >> pure True | otherwise = pure False {-# INLINE atomicWriteIntArray #-} @@ -65,7 +65,7 @@ casIntArray :: -> Int -- ^ New value -> m (Maybe Int) casIntArray marr ix e n - | isSafeIndex (msize marr) ix = Just <$> unsafeCasIntArray marr ix e n + | isSafeIndex (sizeOfMArray marr) ix = Just <$> unsafeCasIntArray marr ix e n | otherwise = pure Nothing {-# INLINE casIntArray #-} @@ -77,7 +77,7 @@ casIntArray marr ix e n atomicModifyIntArray :: (Index ix, PrimMonad m) => MArray (PrimState m) P ix Int -> ix -> (Int -> Int) -> m (Maybe Int) atomicModifyIntArray marr ix f - | isSafeIndex (msize marr) ix = Just <$> unsafeAtomicModifyIntArray marr ix f + | isSafeIndex (sizeOfMArray marr) ix = Just <$> unsafeAtomicModifyIntArray marr ix f | otherwise = pure Nothing {-# INLINE atomicModifyIntArray #-} @@ -88,7 +88,7 @@ atomicModifyIntArray marr ix f atomicAddIntArray :: (Index ix, PrimMonad m) => MArray (PrimState m) P ix Int -> ix -> Int -> m (Maybe Int) atomicAddIntArray marr ix e - | isSafeIndex (msize marr) ix = Just <$> unsafeAtomicAddIntArray marr ix e + | isSafeIndex (sizeOfMArray marr) ix = Just <$> unsafeAtomicAddIntArray marr ix e | otherwise = pure Nothing {-# INLINE atomicAddIntArray #-} @@ -99,7 +99,7 @@ atomicAddIntArray marr ix e atomicSubIntArray :: (Index ix, PrimMonad m) => MArray (PrimState m) P ix Int -> ix -> Int -> m (Maybe Int) atomicSubIntArray marr ix e - | isSafeIndex (msize marr) ix = Just <$> unsafeAtomicSubIntArray marr ix e + | isSafeIndex (sizeOfMArray marr) ix = Just <$> unsafeAtomicSubIntArray marr ix e | otherwise = pure Nothing {-# INLINE atomicSubIntArray #-} @@ -110,7 +110,7 @@ atomicSubIntArray marr ix e atomicAndIntArray :: (Index ix, PrimMonad m) => MArray (PrimState m) P ix Int -> ix -> Int -> m (Maybe Int) atomicAndIntArray marr ix e - | isSafeIndex (msize marr) ix = Just <$> unsafeAtomicAndIntArray marr ix e + | isSafeIndex (sizeOfMArray marr) ix = Just <$> unsafeAtomicAndIntArray marr ix e | otherwise = pure Nothing {-# INLINE atomicAndIntArray #-} @@ -121,7 +121,7 @@ atomicAndIntArray marr ix e atomicNandIntArray :: (Index ix, PrimMonad m) => MArray (PrimState m) P ix Int -> ix -> Int -> m (Maybe Int) atomicNandIntArray marr ix e - | isSafeIndex (msize marr) ix = Just <$> unsafeAtomicNandIntArray marr ix e + | isSafeIndex (sizeOfMArray marr) ix = Just <$> unsafeAtomicNandIntArray marr ix e | otherwise = pure Nothing {-# INLINE atomicNandIntArray #-} @@ -132,7 +132,7 @@ atomicNandIntArray marr ix e atomicOrIntArray :: (Index ix, PrimMonad m) => MArray (PrimState m) P ix Int -> ix -> Int -> m (Maybe Int) atomicOrIntArray marr ix e - | isSafeIndex (msize marr) ix = Just <$> unsafeAtomicOrIntArray marr ix e + | isSafeIndex (sizeOfMArray marr) ix = Just <$> unsafeAtomicOrIntArray marr ix e | otherwise = pure Nothing {-# INLINE atomicOrIntArray #-} @@ -143,6 +143,6 @@ atomicOrIntArray marr ix e atomicXorIntArray :: (Index ix, PrimMonad m) => MArray (PrimState m) P ix Int -> ix -> Int -> m (Maybe Int) atomicXorIntArray marr ix e - | isSafeIndex (msize marr) ix = Just <$> unsafeAtomicXorIntArray marr ix e + | isSafeIndex (sizeOfMArray marr) ix = Just <$> unsafeAtomicXorIntArray marr ix e | otherwise = pure Nothing {-# INLINE atomicXorIntArray #-} diff --git a/massiv/src/Data/Massiv/Array/Ops/Map.hs b/massiv/src/Data/Massiv/Array/Ops/Map.hs index 0b89fc7e..8e7e44ef 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Map.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Map.hs @@ -50,6 +50,9 @@ module Data.Massiv.Array.Ops.Map , iforIO_ , imapSchedulerM_ , iforSchedulerM_ + , iterArrayLinearM_ + , iterArrayLinearWithSetM_ + , iterArrayLinearWithStrideM_ -- ** Zipping , zip , zip3 @@ -522,78 +525,70 @@ iforM_ = flip imapM_ -- -- @since 0.2.6 mapIO :: - forall r ix b r' a m. (Source r' a, Mutable r b, Index ix, MonadUnliftIO m) + forall r ix b r' a m. (Size r', Load r' ix a, Mutable r b, MonadUnliftIO m) => (a -> m b) -> Array r' ix a -> m (Array r ix b) mapIO action = imapIO (const action) {-# INLINE mapIO #-} --- | Similar to `mapIO`, but ignores the result of mapping action and does not create a resulting --- array, therefore it is faster. Use this instead of `mapIO` when result is irrelevant. +-- | Similar to `mapIO`, but ignores the result of mapping action and does not +-- create a resulting array, therefore it is faster. Use this instead of `mapIO` +-- when result is irrelevant. Most importantly it will follow the iteration +-- logic outlined by the supplied array. -- -- @since 0.2.6 -mapIO_ :: (Index ix, Source r e, MonadUnliftIO m) => (e -> m a) -> Array r ix e -> m () -mapIO_ action = imapIO_ (const action) +mapIO_ :: + forall r ix e a m. (Load r ix e, MonadUnliftIO m) + => (e -> m a) + -> Array r ix e + -> m () +mapIO_ action arr = + withRunInIO $ \run -> + withMassivScheduler_ (getComp arr) $ \scheduler -> + iterArrayLinearM_ scheduler arr (\_ -> void . run . action) {-# INLINE mapIO_ #-} -- | Same as `mapIO_`, but map an index aware action instead. -- -- @since 0.2.6 -imapIO_ :: (Index ix, Source r e, MonadUnliftIO m) => (ix -> e -> m a) -> Array r ix e -> m () -imapIO_ action arr = - withScheduler_ (getComp arr) $ \scheduler -> - withRunInIO $ \run -> imapSchedulerM_ scheduler (\ix -> run . action ix) arr -{-# INLINE imapIO_ #-} - --- | Same as `imapM_`, but will use the supplied scheduler. --- --- @since 0.3.1 -imapSchedulerM_ :: - (Index ix, Source r e, MonadPrimBase s m) - => Scheduler s () - -> (ix -> e -> m a) +imapIO_ :: + forall r ix e a m. (Load r ix e, MonadUnliftIO m) + => (ix -> e -> m a) -> Array r ix e -> m () -imapSchedulerM_ scheduler action arr = do - let sz = size arr - splitLinearlyWith_ - scheduler - (totalElem sz) - (unsafeLinearIndex arr) - (\i -> void . action (fromLinearIndex sz i)) -{-# INLINE imapSchedulerM_ #-} - - --- | Same as `imapM_`, but will use the supplied scheduler. --- --- @since 0.3.1 -iforSchedulerM_ :: - (Index ix, Source r e, MonadPrimBase s m) - => Scheduler s () - -> Array r ix e - -> (ix -> e -> m a) - -> m () -iforSchedulerM_ scheduler arr action = imapSchedulerM_ scheduler action arr -{-# INLINE iforSchedulerM_ #-} +imapIO_ action arr = + withRunInIO $ \run -> + withMassivScheduler_ (getComp arr) $ \scheduler -> + let sz = outerSize arr + -- It is ok to user outerSize in context of DS (never evaluated) and L as well + in iterArrayLinearM_ scheduler arr (\i -> void . run . action (fromLinearIndex sz i)) +{-# INLINE imapIO_ #-} -- | Same as `mapIO` but map an index aware action instead. Respects computation strategy. -- -- @since 0.2.6 imapIO :: - forall r ix b r' a m. (Source r' a, Mutable r b, Index ix, MonadUnliftIO m) + forall r ix b r' a m. (Size r', Load r' ix a, Mutable r b, MonadUnliftIO m) => (ix -> a -> m b) -> Array r' ix a -> m (Array r ix b) -imapIO action arr = generateArray (getComp arr) (size arr) $ \ix -> action ix (unsafeIndex arr ix) +imapIO action arr = do + withRunInIO $ \run -> do + marr <- unsafeNew $ size arr + withMassivScheduler_ (getComp arr) $ \scheduler -> + let sz = outerSize arr + -- It is ok to user outerSize in context of DS (never evaluated) and L as well + in iterArrayLinearM_ scheduler arr (\i -> void . run . action (fromLinearIndex sz i)) + unsafeFreeze (getComp arr) marr {-# INLINE imapIO #-} -- | Same as `mapIO` but with arguments flipped. -- -- @since 0.2.6 forIO :: - forall r ix b r' a m. (Source r' a, Mutable r b, Index ix, MonadUnliftIO m) + forall r ix b r' a m. (Size r', Load r' ix a, Mutable r b, MonadUnliftIO m) => Array r' ix a -> (a -> m b) -> m (Array r ix b) @@ -670,7 +665,7 @@ forWS states arr f = imapWS states (\ _ -> f) arr -- 499500 -- -- @since 0.2.6 -forIO_ :: (Index ix, Source r e, MonadUnliftIO m) => Array r ix e -> (e -> m a) -> m () +forIO_ :: (Load r ix e, MonadUnliftIO m) => Array r ix e -> (e -> m a) -> m () forIO_ = flip mapIO_ {-# INLINE forIO_ #-} @@ -678,7 +673,7 @@ forIO_ = flip mapIO_ -- -- @since 0.2.6 iforIO :: - forall r ix b r' a m. (Source r' a, Mutable r b, Index ix, MonadUnliftIO m) + forall r ix b r' a m. (Size r', Load r' ix a, Mutable r b, MonadUnliftIO m) => Array r' ix a -> (ix -> a -> m b) -> m (Array r ix b) @@ -688,6 +683,127 @@ iforIO = flip imapIO -- | Same as `imapIO_` but with arguments flipped. -- -- @since 0.2.6 -iforIO_ :: (Source r a, Index ix, MonadUnliftIO m) => Array r ix a -> (ix -> a -> m b) -> m () +iforIO_ :: + forall r ix e a m. (Load r ix e, MonadUnliftIO m) + => Array r ix e + -> (ix -> e -> m a) + -> m () iforIO_ = flip imapIO_ {-# INLINE iforIO_ #-} + + + + +iterArrayLinearM_ :: + forall r ix e m s. (Load r ix e, MonadPrimBase s m) + => Scheduler s () + -> Array r ix e -- ^ Array that is being loaded + -> (Int -> e -> m ()) -- ^ Function that writes an element into target array + -> m () +iterArrayLinearM_ scheduler arr f = + stToPrim $ iterArrayLinearST_ scheduler arr (\i -> primToPrim . f i) +{-# INLINE iterArrayLinearM_ #-} + +iterArrayLinearWithSetM_ :: + forall r ix e m s. (Load r ix e, MonadPrimBase s m) + => Scheduler s () + -> Array r ix e -- ^ Array that is being loaded + -> (Int -> e -> m ()) -- ^ Function that writes an element into target array + -> (Ix1 -> Sz1 -> e -> m ()) -- ^ Function that efficiently sets a region of an array + -- to the supplied value target array + -> m () +iterArrayLinearWithSetM_ scheduler arr f set = + stToPrim $ + iterArrayLinearWithSetST_ scheduler arr (\i -> primToPrim . f i) (\i n -> primToPrim . set i n) +{-# INLINE iterArrayLinearWithSetM_ #-} + +iterArrayLinearWithStrideM_ :: + forall r ix e m s. (StrideLoad r ix e, MonadPrimBase s m) + => Scheduler s () + -> Stride ix -- ^ Stride to use + -> Sz ix -- ^ Size of the target array affected by the stride. + -> Array r ix e -- ^ Array that is being loaded + -> (Int -> e -> m ()) -- ^ Function that writes an element into target array + -> m () +iterArrayLinearWithStrideM_ scheduler stride sz arr f = + stToPrim $ iterArrayLinearWithStrideST_ scheduler stride sz arr (\i -> primToPrim . f i) +{-# INLINE iterArrayLinearWithStrideM_ #-} + + +-- iterArrayM_ :: +-- Scheduler s () +-- -> Array r ix e -- ^ Array that is being loaded +-- -> (Int -> e -> ST s ()) -- ^ Function that writes an element into target array +-- -> ST s () +-- iterArrayM_ scheduler arr uWrite + +-- Deprecated + + +-- | Same as `imapM_`, but will use the supplied scheduler. +-- +-- @since 0.3.1 +imapSchedulerM_ :: + (Index ix, Source r e, MonadPrimBase s m) + => Scheduler s () + -> (ix -> e -> m a) + -> Array r ix e + -> m () +imapSchedulerM_ scheduler action arr = do + let sz = size arr + splitLinearlyWith_ + scheduler + (totalElem sz) + (unsafeLinearIndex arr) + (\i -> void . action (fromLinearIndex sz i)) +{-# INLINE imapSchedulerM_ #-} + + +-- | Same as `imapM_`, but will use the supplied scheduler. +-- +-- @since 0.3.1 +iforSchedulerM_ :: + (Index ix, Source r e, MonadPrimBase s m) + => Scheduler s () + -> Array r ix e + -> (ix -> e -> m a) + -> m () +iforSchedulerM_ scheduler arr action = imapSchedulerM_ scheduler action arr +{-# INLINE iforSchedulerM_ #-} + + +-- -- | Load an array into memory. +-- -- +-- -- @since 0.3.0 +-- loadArrayM +-- :: Scheduler s () +-- -> Array r ix e -- ^ Array that is being loaded +-- -> (Int -> e -> ST s ()) -- ^ Function that writes an element into target array +-- -> ST s () +-- loadArrayM scheduler arr uWrite = +-- loadArrayWithSetM scheduler arr uWrite $ \offset sz e -> +-- loopM_ offset (< (offset + unSz sz)) (+1) (`uWrite` e) +-- {-# INLINE loadArrayM #-} + +-- -- | Load an array into memory, just like `loadArrayM`. Except it also accepts a +-- -- function that is potentially optimized for setting many cells in a region to the same +-- -- value +-- -- +-- -- @since 0.5.8 +-- loadArrayWithSetM +-- :: Scheduler s () +-- -> Array r ix e -- ^ Array that is being loaded +-- -> (Ix1 -> e -> ST s ()) -- ^ Function that writes an element into target array +-- -> (Ix1 -> Sz1 -> e -> ST s ()) -- ^ Function that efficiently sets a region of an array +-- -- to the supplied value target array +-- -> ST s () +-- loadArrayWithSetM scheduler arr uWrite _ = loadArrayM scheduler arr uWrite +-- {-# INLINE loadArrayWithSetM #-} + + -- iterArrayLinearWithStrideST + -- :: Scheduler s () + -- -> Stride ix -- ^ Stride to use + -- -> Sz ix -- ^ Size of the target array affected by the stride. + -- -> Array r ix e -- ^ Array that is being loaded + -- -> (Int -> e -> ST s ()) -- ^ Function that writes an element into target array + -- -> ST s () diff --git a/massiv/src/Data/Massiv/Array/Ops/Sort.hs b/massiv/src/Data/Massiv/Array/Ops/Sort.hs index a6cb2e78..339960f1 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Sort.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Sort.hs @@ -161,7 +161,7 @@ quicksortInternalM_ :: -> MVector s r e -> m () quicksortInternalM_ fLT fEQ scheduler marr = - scheduleWork scheduler $ qsort (numWorkers scheduler) 0 (unSz (msize marr) - 1) + scheduleWork scheduler $ qsort (numWorkers scheduler) 0 (unSz (sizeOfMArray marr) - 1) where ltSwap i j = do ei <- unsafeLinearRead marr i diff --git a/massiv/src/Data/Massiv/Array/Ops/Transform.hs b/massiv/src/Data/Massiv/Array/Ops/Transform.hs index a288b3cf..f3a0ff84 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Transform.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Transform.hs @@ -136,8 +136,9 @@ extractFromTo' sIx eIx = extract' sIx $ Sz (liftIndex2 (-) eIx sIx) {-# INLINE extractFromTo' #-} --- | /O(1)/ - Changes the shape of an array. Returns `Nothing` if total --- number of elements does not match the source array. +-- | /O(1)/ - Change the size of an array. Throws +-- `SizeElementsMismatchException` if total number of elements does not match +-- the supplied array. -- -- @since 0.3.0 resizeM :: @@ -1034,7 +1035,7 @@ upsample !fillWith safeStride arr = load :: Loader e load scheduler startAt uWrite uSet = do uSet startAt (toLinearSz newsz) fillWith - loadArrayM scheduler arr (\i -> uWrite (adjustLinearStride (i + startAt))) + iterArrayLinearST_ scheduler arr (\i -> uWrite (adjustLinearStride (i + startAt))) {-# INLINE load #-} adjustLinearStride = toLinearIndex newsz . timesStride . fromLinearIndex sz {-# INLINE adjustLinearStride #-} diff --git a/massiv/src/Data/Massiv/Array/Unsafe.hs b/massiv/src/Data/Massiv/Array/Unsafe.hs index 6e25e96e..522d48c1 100644 --- a/massiv/src/Data/Massiv/Array/Unsafe.hs +++ b/massiv/src/Data/Massiv/Array/Unsafe.hs @@ -1,7 +1,9 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE MonoLocalBinds #-} -- | -- Module : Data.Massiv.Array.Unsafe -- Copyright : (c) Alexey Kuleshevich 2018-2021 @@ -32,10 +34,13 @@ module Data.Massiv.Array.Unsafe , unsafeInnerSlice , unsafeLinearSlice -- * Mutable interface - , munsafeResize + , unsafeResizeMArray + , unsafeLinearSliceMArray , unsafeThaw , unsafeFreeze , unsafeNew + , unsafeLoadIntoST + , unsafeLoadIntoIO , unsafeLoadIntoS , unsafeLoadIntoM , unsafeCreateArray @@ -88,6 +93,7 @@ module Data.Massiv.Array.Unsafe , module Data.Massiv.Array.Stencil.Unsafe ) where +import Control.Monad.Primitive import Data.Massiv.Array.Delayed.Pull (D, unsafeExtract, unsafeSlice, unsafeInnerSlice) import Data.Massiv.Array.Delayed.Push (unsafeMakeLoadArray, unsafeMakeLoadArrayAdjusted) import Data.Massiv.Array.Manifest.Boxed @@ -138,3 +144,28 @@ unsafeTransform2 getSz get arr1 arr2 = where (sz, a) = getSz (size arr1) (size arr2) {-# INLINE unsafeTransform2 #-} + + + +-- | Load into a supplied mutable array sequentially. Returned array does not have to be +-- the same +-- +-- @since 0.5.7 +unsafeLoadIntoS :: + forall r r' ix e m s. (Load r ix e, Mutable r' e, MonadPrim s m) + => MVector s r' e + -> Array r ix e + -> m (MArray s r' ix e) +unsafeLoadIntoS marr arr = stToPrim $ unsafeLoadIntoS marr arr +{-# INLINE unsafeLoadIntoS #-} + +-- | Same as `unsafeLoadIntoS`, but respecting computation strategy. +-- +-- @since 0.5.7 +unsafeLoadIntoM :: + forall r r' ix e m. (Load r ix e, Mutable r' e, MonadIO m) + => MVector RealWorld r' e + -> Array r ix e + -> m (MArray RealWorld r' ix e) +unsafeLoadIntoM marr arr = liftIO $ unsafeLoadIntoIO marr arr +{-# INLINE unsafeLoadIntoM #-} diff --git a/massiv/src/Data/Massiv/Core.hs b/massiv/src/Data/Massiv/Core.hs index 04c8a38f..7324e80a 100644 --- a/massiv/src/Data/Massiv/Core.hs +++ b/massiv/src/Data/Massiv/Core.hs @@ -13,7 +13,7 @@ module Data.Massiv.Core , Matrix , MMatrix , Elt - , Load(loadArrayM, loadArrayWithSetM) + , Load(iterArrayLinearST_, iterArrayLinearWithSetST_) , Stream(..) , Source , Size diff --git a/massiv/src/Data/Massiv/Core/Common.hs b/massiv/src/Data/Massiv/Core/Common.hs index 4d265f5e..f5563f8a 100644 --- a/massiv/src/Data/Massiv/Core/Common.hs +++ b/massiv/src/Data/Massiv/Core/Common.hs @@ -116,7 +116,7 @@ import Data.Vector.Fusion.Util -- | The array family. Representations @r@ describe how data is arranged or computed. All -- arrays have a common property that each index @ix@ always maps to the same unique -- element @e@, even if that element does not yet exist in memory and the array has to be --- computed in order to get access to that element. Data is always arranged in a nested +-- computed in order to get the value of that element. Data is always arranged in a nested -- row-major fashion. Rank of an array is specified by @`Dimensions` ix@. data family Array r ix e :: Type @@ -315,7 +315,7 @@ class (Strategy r, Resize r) => Source r e where -- | Any array that can be computed and loaded into memory class (Strategy r, Shape r ix) => Load r ix e where - {-# MINIMAL (makeArray | makeArrayLinear), (loadArrayM | loadArrayWithSetM)#-} + {-# MINIMAL (makeArray | makeArrayLinear), (iterArrayLinearST_ | iterArrayLinearWithSetST_)#-} -- | Construct an Array. Resulting type either has to be unambiguously inferred or restricted -- manually, like in the example below. Use "Data.Massiv.Array.makeArrayR" if you'd like to @@ -372,85 +372,92 @@ class (Strategy r, Shape r ix) => Load r ix e where {-# INLINE replicate #-} - -- | Load an array into memory. + -- | Iterate over an array with a ST action that is applied to each element and its index. -- - -- @since 0.3.0 - loadArrayM + -- @since 1.0.0 + iterArrayLinearST_ :: Scheduler s () -> Array r ix e -- ^ Array that is being loaded -> (Int -> e -> ST s ()) -- ^ Function that writes an element into target array -> ST s () - loadArrayM scheduler arr uWrite = - loadArrayWithSetM scheduler arr uWrite $ \offset sz e -> + iterArrayLinearST_ scheduler arr uWrite = + iterArrayLinearWithSetST_ scheduler arr uWrite $ \offset sz e -> loopM_ offset (< (offset + unSz sz)) (+1) (`uWrite` e) - {-# INLINE loadArrayM #-} + {-# INLINE iterArrayLinearST_ #-} - -- | Load an array into memory, just like `loadArrayM`. Except it also accepts a - -- function that is potentially optimized for setting many cells in a region to the same - -- value + -- | Similar to `iterArrayLinearST_`. Except it also accepts a function that is + -- potentially optimized for setting many cells in a region to the same + -- value. There is no guarantees, but some array representations, might + -- utilize this region setting function, in which case for such regions index + -- aware action will not be called. -- - -- @since 0.5.8 - loadArrayWithSetM + -- @since 1.0.0 + iterArrayLinearWithSetST_ :: Scheduler s () -> Array r ix e -- ^ Array that is being loaded -> (Ix1 -> e -> ST s ()) -- ^ Function that writes an element into target array -> (Ix1 -> Sz1 -> e -> ST s ()) -- ^ Function that efficiently sets a region of an array -- to the supplied value target array -> ST s () - loadArrayWithSetM scheduler arr uWrite _ = loadArrayM scheduler arr uWrite - {-# INLINE loadArrayWithSetM #-} + iterArrayLinearWithSetST_ scheduler arr uWrite _ = iterArrayLinearST_ scheduler arr uWrite + {-# INLINE iterArrayLinearWithSetST_ #-} + -- | Load into a supplied mutable array sequentially. Returned array does not have to be + -- the same. + -- + -- @since 1.0.0 + unsafeLoadIntoST' :: + Mutable r' a + => MVector s r' a + -> Array r ix e + -> (e -> ST s a) + -> ST s (MArray s r' ix a) + unsafeLoadIntoST' marr arr f = do + iterArrayLinearWithSetST_ trivialScheduler_ arr (\ix e -> f e >>= unsafeLinearWrite marr ix) + $ \ix sz e -> f e >>= unsafeLinearSet marr ix sz + pure $ unsafeResizeMArray (outerSize arr) marr + {-# INLINE unsafeLoadIntoST' #-} -- | Load into a supplied mutable array sequentially. Returned array does not have to be - -- the same + -- the same. -- - -- @since 0.5.7 - unsafeLoadIntoS :: + -- @since 1.0.0 + unsafeLoadIntoST :: Mutable r' e => MVector s r' e -> Array r ix e -> ST s (MArray s r' ix e) - unsafeLoadIntoS marr arr = - munsafeResize (outerSize arr) marr <$ - loadArrayWithSetM trivialScheduler_ arr (unsafeLinearWrite marr) (unsafeLinearSet marr) - {-# INLINE unsafeLoadIntoS #-} + unsafeLoadIntoST marr arr = + unsafeResizeMArray (outerSize arr) marr <$ + iterArrayLinearWithSetST_ trivialScheduler_ arr (unsafeLinearWrite marr) (unsafeLinearSet marr) + {-# INLINE unsafeLoadIntoST #-} - -- | Same as `unsafeLoadIntoS`, but respecting computation strategy. + -- | Same as `unsafeLoadIntoST`, but respecting computation strategy. -- - -- @since 0.5.7 - unsafeLoadIntoM :: + -- @since 1.0.0 + unsafeLoadIntoIO :: Mutable r' e => MVector RealWorld r' e -> Array r ix e -> IO (MArray RealWorld r' ix e) - unsafeLoadIntoM marr arr = do + unsafeLoadIntoIO marr arr = do withMassivScheduler_ (getComp arr) $ \scheduler -> - stToIO $ loadArrayWithSetM scheduler arr (unsafeLinearWrite marr) (unsafeLinearSet marr) - pure $ munsafeResize (outerSize arr) marr - {-# INLINE unsafeLoadIntoM #-} + stToIO $ iterArrayLinearWithSetST_ scheduler arr (unsafeLinearWrite marr) (unsafeLinearSet marr) + pure $ unsafeResizeMArray (outerSize arr) marr + {-# INLINE unsafeLoadIntoIO #-} --- | Selects an optimal scheduler for the supplied strategy, but it works only in `IO` --- --- @since 1.0.0 -withMassivScheduler_ :: Comp -> (Scheduler RealWorld () -> IO ()) -> IO () -withMassivScheduler_ comp f = - case comp of - Par -> withGlobalScheduler_ globalScheduler f - Seq -> f trivialScheduler_ - _ -> withScheduler_ comp f -{-# INLINE withMassivScheduler_ #-} class (Size r, Load r ix e) => StrideLoad r ix e where -- | Load an array into memory with stride. Default implementation requires an instance of -- `Source`. - loadArrayWithStrideM + iterArrayLinearWithStrideST_ :: Scheduler s () -> Stride ix -- ^ Stride to use -> Sz ix -- ^ Size of the target array affected by the stride. -> Array r ix e -- ^ Array that is being loaded -> (Int -> e -> ST s ()) -- ^ Function that writes an element into target array -> ST s () - default loadArrayWithStrideM + default iterArrayLinearWithStrideST_ :: Source r e => Scheduler s () -> Stride ix @@ -458,19 +465,19 @@ class (Size r, Load r ix e) => StrideLoad r ix e where -> Array r ix e -> (Int -> e -> ST s ()) -> ST s () - loadArrayWithStrideM scheduler stride resultSize arr = + iterArrayLinearWithStrideST_ scheduler stride resultSize arr = splitLinearlyWith_ scheduler (totalElem resultSize) unsafeLinearWriteWithStride where !strideIx = unStride stride unsafeLinearWriteWithStride = unsafeIndex arr . liftIndex2 (*) strideIx . fromLinearIndex resultSize {-# INLINE unsafeLinearWriteWithStride #-} - {-# INLINE loadArrayWithStrideM #-} + {-# INLINE iterArrayLinearWithStrideST_ #-} -- class (Load r ix e) => StrideLoad r ix e where -- class (Size r, StrideLoad r ix e) => StrideLoadP r ix e where -- - -- unsafeLoadIntoWithStrideST :: + -- unsafeLoadIntoWithStrideST :: -- TODO: this would remove Size constraint and allow DS and LN instances for vectors. -- Mutable r' ix e -- => Array r ix e -- -> Stride ix -- ^ Stride to use @@ -478,10 +485,6 @@ class (Size r, Load r ix e) => StrideLoad r ix e where -- -> m (MArray RealWorld r' ix e) ---TODO: rethink Size here to support outer slicing (Something like OuterSize?) Affects ---only ragged arrays (L, LN and DS don't count, since they don't have constant time ---slicing anyways) - -- | Manifest arrays are backed by actual memory and values are looked up versus -- computed as it is with delayed arrays. Because of this fact indexing functions -- @(`!`)@, @(`!?`)@, etc. are constrained to manifest arrays only. @@ -489,19 +492,25 @@ class (Resize r, Source r e) => Manifest r e where unsafeLinearIndexM :: Index ix => Array r ix e -> Int -> e - class Manifest r e => Mutable r e where data MArray s r ix e :: Type - -- | Get the size of a mutable array. + -- | /O(1)/ - Get the size of a mutable array. -- - -- @since 0.1.0 - msize :: Index ix => MArray s r ix e -> Sz ix + -- @since 1.0.0 + sizeOfMArray :: Index ix => MArray s r ix e -> Sz ix - -- | Get the size of a mutable array. + -- | /O(1)/ - Change the size of a mutable array. The actual number of + -- elements should stay the same. -- - -- @since 0.1.0 - munsafeResize :: (Index ix', Index ix) => Sz ix' -> MArray s r ix e -> MArray s r ix' e + -- @since 1.0.0 + unsafeResizeMArray :: (Index ix', Index ix) => Sz ix' -> MArray s r ix e -> MArray s r ix' e + + -- | /O(1)/ - Take a linear slice out of a mutable array. + -- + -- @since 1.0.0 + unsafeLinearSliceMArray :: Index ix => Ix1 -> Sz1 -> MArray s r ix e -> MVector s r e + -- | Convert immutable array into a mutable array without copy. -- @@ -610,7 +619,7 @@ class Manifest r e => Mutable r e where MArray (PrimState m) r ix e -> Sz ix -> m (MArray (PrimState m) r ix e) unsafeLinearGrow marr sz = do marr' <- unsafeNew sz - unsafeLinearCopy marr 0 marr' 0 $ SafeSz (totalElem (msize marr)) + unsafeLinearCopy marr 0 marr' 0 $ SafeSz (totalElem (sizeOfMArray marr)) pure marr' {-# INLINE unsafeLinearGrow #-} @@ -627,12 +636,24 @@ unsafeDefaultLinearShrink marr sz = do {-# INLINE unsafeDefaultLinearShrink #-} +-- | Selects an optimal scheduler for the supplied strategy, but it works only in `IO` +-- +-- @since 1.0.0 +withMassivScheduler_ :: Comp -> (Scheduler RealWorld () -> IO ()) -> IO () +withMassivScheduler_ comp f = + case comp of + Par -> withGlobalScheduler_ globalScheduler f + Seq -> f trivialScheduler_ + _ -> withScheduler_ comp f +{-# INLINE withMassivScheduler_ #-} + + -- | Read an array element -- -- @since 0.1.0 unsafeRead :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> m e -unsafeRead marr = unsafeLinearRead marr . toLinearIndex (msize marr) +unsafeRead marr = unsafeLinearRead marr . toLinearIndex (sizeOfMArray marr) {-# INLINE unsafeRead #-} -- | Write an element into array @@ -640,7 +661,7 @@ unsafeRead marr = unsafeLinearRead marr . toLinearIndex (msize marr) -- @since 0.1.0 unsafeWrite :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> e -> m () -unsafeWrite marr = unsafeLinearWrite marr . toLinearIndex (msize marr) +unsafeWrite marr = unsafeLinearWrite marr . toLinearIndex (sizeOfMArray marr) {-# INLINE unsafeWrite #-} @@ -661,7 +682,7 @@ unsafeLinearModify !marr f !i = do -- @since 0.4.0 unsafeModify :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (e -> m e) -> ix -> m e -unsafeModify marr f ix = unsafeLinearModify marr f (toLinearIndex (msize marr) ix) +unsafeModify marr f ix = unsafeLinearModify marr f (toLinearIndex (sizeOfMArray marr) ix) {-# INLINE unsafeModify #-} -- | Swap two elements in a mutable array under the supplied indices. Returns the previous @@ -671,7 +692,7 @@ unsafeModify marr f ix = unsafeLinearModify marr f (toLinearIndex (msize marr) i unsafeSwap :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> ix -> m (e, e) unsafeSwap !marr !ix1 !ix2 = unsafeLinearSwap marr (toLinearIndex sz ix1) (toLinearIndex sz ix2) - where sz = msize marr + where sz = sizeOfMArray marr {-# INLINE unsafeSwap #-} @@ -702,8 +723,8 @@ class (IsList (Array r ix e), Load r ix e) => Ragged r ix e where flattenRagged :: Array r ix e -> Vector r e - loadRagged :: - Scheduler s () -> (Ix1 -> e -> ST s a) -> Ix1 -> Ix1 -> Sz ix -> Array r ix e -> ST s () + loadRaggedST :: + Scheduler s () -> Array r ix e -> (Ix1 -> e -> ST s ()) -> Ix1 -> Ix1 -> Sz ix -> ST s () raggedFormat :: (e -> String) -> String -> Array r ix e -> String diff --git a/massiv/src/Data/Massiv/Core/List.hs b/massiv/src/Data/Massiv/Core/List.hs index 87598ab9..a15e1d65 100644 --- a/massiv/src/Data/Massiv/Core/List.hs +++ b/massiv/src/Data/Massiv/Core/List.hs @@ -29,7 +29,6 @@ module Data.Massiv.Core.List , ListItem ) where -import Control.Exception import Control.Monad (unless, when) import Control.Scheduler import Data.Coerce @@ -177,25 +176,25 @@ instance Ragged L Ix1 e where return (e:acc) return $ LArray comp $ coerce xs {-# INLINE generateRaggedM #-} - loadRagged scheduler uWrite start end sz xs = + loadRaggedST scheduler xs uWrite start end sz = scheduleWork scheduler $ do leftOver <- loopM start (< end) (+ 1) xs $ \i xs' -> case unconsR xs' of - Nothing -> return $! throw (DimTooShortException sz (outerLength xs)) + Nothing -> throwM (DimTooShortException sz (outerLength xs)) Just (y, ys) -> uWrite i y >> return ys - unless (isNull leftOver) (return $! throw DimTooLongException) - {-# INLINE loadRagged #-} + unless (isNull leftOver) (throwM DimTooLongException) + {-# INLINE loadRaggedST #-} raggedFormat f _ arr = L.concat $ "[ " : L.intersperse ", " (map f (coerce (lData arr))) ++ [" ]"] instance (Shape L ix, Ragged L ix e) => Load L ix e where makeArray comp sz f = runIdentity $ generateRaggedM comp sz (pure . f) {-# INLINE makeArray #-} - loadArrayM scheduler arr uWrite = - loadRagged scheduler uWrite 0 (totalElem sz) sz arr + iterArrayLinearST_ scheduler arr uWrite = + loadRaggedST scheduler arr uWrite 0 (totalElem sz) sz where !sz = outerSize arr - {-# INLINE loadArrayM #-} + {-# INLINE iterArrayLinearST_ #-} instance Ragged L Ix2 e where emptyR comp = LArray comp (List []) @@ -218,21 +217,21 @@ instance Ragged L Ix2 e where where xs = concatMap (unList . lData . flattenRagged . LArray (lComp arr)) (unList (lData arr)) {-# INLINE flattenRagged #-} - loadRagged scheduler uWrite start end sz xs = do + loadRaggedST scheduler xs uWrite start end sz = do let (k, szL) = unconsSz sz step = totalElem szL isZero = totalElem sz == 0 - when (isZero && isNotNull (flattenRagged xs)) (return $! throw DimTooLongException) + when (isZero && isNotNull (flattenRagged xs)) (throwM DimTooLongException) unless isZero $ do leftOver <- loopM start (< end) (+ step) xs $ \i zs -> case unconsR zs of - Nothing -> return $! throw (DimTooShortException k (outerLength xs)) + Nothing -> throwM (DimTooShortException k (outerLength xs)) Just (y, ys) -> do - _ <- loadRagged scheduler uWrite i (i + step) szL y + _ <- loadRaggedST scheduler y uWrite i (i + step) szL return ys - unless (isNull leftOver) (return $! throw DimTooLongException) - {-# INLINE loadRagged #-} + unless (isNull leftOver) (throwM DimTooLongException) + {-# INLINE loadRaggedST #-} raggedFormat f sep (LArray comp xs) = showN (\s y -> raggedFormat f s (LArray comp y :: Array L Ix1 e)) sep (coerce xs) @@ -263,21 +262,21 @@ instance ( Shape L (IxN n) where xs = concatMap (unList . lData . flattenRagged . LArray (lComp arr)) (unList (lData arr)) {-# INLINE flattenRagged #-} - loadRagged scheduler uWrite start end sz xs = do + loadRaggedST scheduler xs uWrite start end sz = do let (k, szL) = unconsSz sz step = totalElem szL isZero = totalElem sz == 0 - when (isZero && isNotNull (flattenRagged xs)) (return $! throw DimTooLongException) + when (isZero && isNotNull (flattenRagged xs)) (throwM DimTooLongException) unless isZero $ do leftOver <- loopM start (< end) (+ step) xs $ \i zs -> case unconsR zs of - Nothing -> return $! throw (DimTooShortException k (outerLength xs)) + Nothing -> throwM (DimTooShortException k (outerLength xs)) Just (y, ys) -> do - _ <- loadRagged scheduler uWrite i (i + step) szL y + _ <- loadRaggedST scheduler y uWrite i (i + step) szL return ys - unless (isNull leftOver) (return $! throw DimTooLongException) - {-# INLINE loadRagged #-} + unless (isNull leftOver) (throwM DimTooLongException) + {-# INLINE loadRaggedST #-} raggedFormat f sep (LArray comp xs) = showN (\s y -> raggedFormat f s (LArray comp y :: Array L (Ix (n - 1)) e)) sep (coerce xs) diff --git a/massiv/src/Data/Massiv/Vector/Stream.hs b/massiv/src/Data/Massiv/Vector/Stream.hs index 01e73c9c..51575d08 100644 --- a/massiv/src/Data/Massiv/Vector/Stream.hs +++ b/massiv/src/Data/Massiv/Vector/Stream.hs @@ -317,7 +317,7 @@ unstreamUnknownM :: => MVector (PrimState m) r a -> S.Stream Id a -> m (MVector (PrimState m) r a) -unstreamUnknownM marrInit (S.Stream step s) = stepLoad s 0 (unSz (msize marrInit)) marrInit +unstreamUnknownM marrInit (S.Stream step s) = stepLoad s 0 (unSz (sizeOfMArray marrInit)) marrInit where stepLoad t i kMax marr | i < kMax = diff --git a/shell.nix b/shell.nix deleted file mode 100644 index 86c94892..00000000 --- a/shell.nix +++ /dev/null @@ -1,18 +0,0 @@ -let - pkgs = import {}; - # Wrapped stack executable that uses the nix-provided GHC - stack = pkgs.stdenv.mkDerivation { - name = "stack-system-ghc"; - builder = pkgs.writeScript "stack" '' - source $stdenv/setup - mkdir -p $out/bin - makeWrapper ${pkgs.stack}/bin/stack $out/bin/stack \ - --add-flags --system-ghc - ''; - buildInputs = [ pkgs.makeWrapper ]; - }; -in pkgs.mkShell -{ - buildInputs = [ stack pkgs.haskellPackages.ghcid pkgs.haskell.compiler.ghc901 pkgs.gmp ]; - -} diff --git a/stack-extra-deps.yaml b/stack-extra-deps.yaml index aa63674f..7c4bb031 100644 --- a/stack-extra-deps.yaml +++ b/stack-extra-deps.yaml @@ -1,4 +1,4 @@ -resolver: lts-14.27 +resolver: lts-16.31 packages: - 'massiv/' - 'massiv-test/' diff --git a/stack.yaml b/stack.yaml index 57048297..80c2eabc 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: nightly-2021-06-19 +resolver: lts-18.3 packages: - 'massiv/' - 'massiv-test/' From da875acbd463b7ee5b560ef771118f5a58206c96 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sat, 24 Jul 2021 13:38:52 +0300 Subject: [PATCH 39/65] Switch to using ForeignPtr for S instead of storable Vector --- massiv/CHANGELOG.md | 2 +- massiv/src/Data/Massiv/Array/Manifest.hs | 6 +- .../Data/Massiv/Array/Manifest/Storable.hs | 172 +++++++++++------- .../src/Data/Massiv/Array/Manifest/Vector.hs | 2 +- massiv/src/Data/Massiv/Core/Common.hs | 18 +- 5 files changed, 109 insertions(+), 91 deletions(-) diff --git a/massiv/CHANGELOG.md b/massiv/CHANGELOG.md index d0c4fb62..1067a001 100644 --- a/massiv/CHANGELOG.md +++ b/massiv/CHANGELOG.md @@ -38,7 +38,7 @@ * `for2PrimM_` and `ifor2PrimM_`, * `zipSwapM_` * Switch effectful mapping functions to use the representation specific - iteration. Which means that they are now restricted to `Load` instead of + iteration. This means that they are now restricted to `Load` instead of `Source`. Functions affected: * `mapIO_`, `imapIO_`, `forIO_` and `iforIO_` * `mapIO`, `imapIO`, `forIO` and `iforIO` diff --git a/massiv/src/Data/Massiv/Array/Manifest.hs b/massiv/src/Data/Massiv/Array/Manifest.hs index 4be3f906..26dc6992 100644 --- a/massiv/src/Data/Massiv/Array/Manifest.hs +++ b/massiv/src/Data/Massiv/Array/Manifest.hs @@ -160,21 +160,21 @@ toBuilder = foldMono -- | /O(1)/ - Cast a storable array of `Word8` to ByteString `Builder`. -- -- @since 0.5.0 -castToBuilder :: Array S ix Word8 -> Builder +castToBuilder :: Index ix => Array S ix Word8 -> Builder castToBuilder = byteString . castToByteString {-# INLINE castToBuilder #-} -- | /O(1)/ - Cast a `S`torable array into a strict `ByteString` -- -- @since 0.3.0 -castToByteString :: Array S ix Word8 -> ByteString +castToByteString :: Index ix => Array S ix Word8 -> ByteString castToByteString = (\(fp, len) -> PS fp 0 len) . unsafeArrayToForeignPtr {-# INLINE castToByteString #-} -- | /O(1)/ - Cast a strict `ByteString` into a `S`torable array -- -- @since 0.3.0 -castFromByteString :: Comp -> ByteString -> Array S Ix1 Word8 +castFromByteString :: Comp -> ByteString -> Vector S Word8 castFromByteString comp (PS fp offset len) = unsafeArrayFromForeignPtr comp fp offset (Sz len) {-# INLINE castFromByteString #-} diff --git a/massiv/src/Data/Massiv/Array/Manifest/Storable.hs b/massiv/src/Data/Massiv/Array/Manifest/Storable.hs index 15b61298..7b9ff67c 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Storable.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Storable.hs @@ -36,39 +36,43 @@ module Data.Massiv.Array.Manifest.Storable import Control.DeepSeq (NFData(..), deepseq) import Control.Exception +import Control.Monad import Control.Monad.IO.Unlift -import Control.Monad.Primitive (unsafePrimToPrim) +import Control.Monad.Primitive import Data.Massiv.Array.Delayed.Pull (compareArrays, eqArrays) import Data.Massiv.Array.Manifest.Internal import Data.Massiv.Array.Manifest.List as A -import Data.Massiv.Array.Manifest.Primitive (shrinkMutableByteArray) import Data.Massiv.Array.Mutable import Data.Massiv.Core.Common import Data.Massiv.Core.List import Data.Massiv.Core.Operations import Data.Massiv.Vector.Stream as S (isteps, steps) -import Data.Primitive.ByteArray (MutableByteArray(..)) -import qualified Data.Vector.Generic.Mutable as VGM -import qualified Data.Vector.Storable as VS -import qualified Data.Vector.Storable.Mutable as MVS -import Foreign.ForeignPtr (newForeignPtr, withForeignPtr) +import Data.Primitive.Ptr (setPtr) +import Data.Primitive.ByteArray +import Foreign.ForeignPtr import Foreign.Marshal.Alloc import Foreign.Marshal.Array (advancePtr, copyArray) import Foreign.Ptr import Foreign.Storable import GHC.Exts as GHC (IsList(..)) -import GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents(..)) +import GHC.ForeignPtr import Prelude hiding (mapM) import System.IO.Unsafe (unsafePerformIO) +import Data.Word +import Unsafe.Coerce + +import qualified Data.Vector.Generic.Mutable as MVG +import qualified Data.Vector.Storable as VS +import qualified Data.Vector.Storable.Mutable as MVS #include "massiv.h" -- | Representation for `Storable` elements data S = S deriving Show -data instance Array S ix e = SArray { sComp :: !Comp - , sSize :: !(Sz ix) - , sData :: !(VS.Vector e) +data instance Array S ix e = SArray { sComp :: !Comp + , sSize :: !(Sz ix) + , sData :: {-# UNPACK #-} !(ForeignPtr e) } instance (Ragged L ix e, Show e, Storable e) => Show (Array S ix e) where @@ -76,11 +80,11 @@ instance (Ragged L ix e, Show e, Storable e) => Show (Array S ix e) where showList = showArrayList instance NFData ix => NFData (Array S ix e) where - rnf (SArray c sz v) = c `deepseq` sz `deepseq` v `deepseq` () + rnf (SArray c sz _v) = c `deepseq` sz `deepseq` () {-# INLINE rnf #-} instance NFData ix => NFData (MArray s S ix e) where - rnf (MSArray sz mv) = sz `deepseq` mv `deepseq` () + rnf (MSArray sz _mv) = sz `deepseq` () {-# INLINE rnf #-} instance (Storable e, Eq e, Index ix) => Eq (Array S ix e) where @@ -97,17 +101,26 @@ instance Strategy S where setComp c arr = arr { sComp = c } {-# INLINE setComp #-} -instance VS.Storable e => Source S e where - unsafeLinearIndex (SArray _ _ v) = - INDEX_CHECK("(Source S ix e).unsafeLinearIndex", Sz . VS.length, VS.unsafeIndex) v +advanceForeignPtr :: forall e . Storable e => ForeignPtr e -> Int -> ForeignPtr e +advanceForeignPtr fp i = plusForeignPtr fp (i * sizeOf (undefined :: e)) +{-# INLINE advanceForeignPtr #-} + +indexForeignPtr :: Storable e => ForeignPtr e -> Int -> e +indexForeignPtr fp i = unsafeInlineIO $ unsafeWithForeignPtr fp $ \p -> peekElemOff p i +{-# INLINE indexForeignPtr #-} + +instance Storable e => Source S e where + unsafeLinearIndex (SArray _ _sz fp) = + INDEX_CHECK("(Source S ix e).unsafeLinearIndex", const (toLinearSz _sz), indexForeignPtr) fp {-# INLINE unsafeLinearIndex #-} - unsafeOuterSlice (SArray c _ v) szL i = + unsafeOuterSlice (SArray c _ fp) szL i = let k = totalElem szL - in SArray c szL $ VS.unsafeSlice (i * k) k v + in SArray c szL $ advanceForeignPtr fp (i * k) {-# INLINE unsafeOuterSlice #-} - unsafeLinearSlice i k (SArray c _ v) = SArray c k $ VS.unsafeSlice i (unSz k) v + unsafeLinearSlice i k (SArray c _ fp) = + SArray c k $ advanceForeignPtr fp (i * unSz k) {-# INLINE unsafeLinearSlice #-} instance Index ix => Shape S ix where @@ -124,49 +137,58 @@ instance Resize S where instance Storable e => Manifest S e where - unsafeLinearIndexM (SArray _ _ v) = - INDEX_CHECK("(Manifest S ix e).unsafeLinearIndexM", Sz . VS.length, VS.unsafeIndex) v + unsafeLinearIndexM (SArray _ _sz fp) = + INDEX_CHECK("(Source S ix e).unsafeLinearIndex", const (toLinearSz _sz), indexForeignPtr) fp {-# INLINE unsafeLinearIndexM #-} instance Storable e => Mutable S e where - data MArray s S ix e = MSArray !(Sz ix) !(VS.MVector s e) + data MArray s S ix e = MSArray !(Sz ix) {-# UNPACK #-} !(ForeignPtr e) sizeOfMArray (MSArray sz _) = sz {-# INLINE sizeOfMArray #-} - unsafeResizeMArray sz (MSArray _ mv) = MSArray sz mv + unsafeResizeMArray sz (MSArray _ fp) = MSArray sz fp {-# INLINE unsafeResizeMArray #-} - unsafeLinearSliceMArray i k (MSArray _ mv) = MSArray k $ MVS.unsafeSlice i (unSz k) mv + unsafeLinearSliceMArray i k (MSArray _ fp) = MSArray k $ advanceForeignPtr fp i {-# INLINE unsafeLinearSliceMArray #-} - unsafeThaw (SArray _ sz v) = MSArray sz <$> VS.unsafeThaw v + unsafeThaw (SArray _ sz fp) = pure $ MSArray sz fp {-# INLINE unsafeThaw #-} - unsafeFreeze comp (MSArray sz v) = SArray comp sz <$> VS.unsafeFreeze v + unsafeFreeze comp (MSArray sz v) = pure $ SArray comp sz v {-# INLINE unsafeFreeze #-} - unsafeNew sz = MSArray sz <$> MVS.unsafeNew (totalElem sz) + unsafeNew sz = do + let !n = totalElem sz + dummy = undefined :: e + !eSize = sizeOf dummy + when (n > (maxBound :: Int) `div` eSize) $ error $ "Array size is too big: " ++ show sz + unsafeIOToPrim $ do + fp <- mallocPlainForeignPtrAlignedBytes (n * sizeOf dummy) (alignment dummy) + pure $ MSArray sz fp {-# INLINE unsafeNew #-} - initialize (MSArray _ marr) = VGM.basicInitialize marr + initialize (MSArray sz fp) = + unsafeIOToPrim $ + unsafeWithForeignPtr fp $ \p -> + setPtr (castPtr p) (totalElem sz * sizeOf (undefined :: e)) (0 :: Word8) {-# INLINE initialize #-} - unsafeLinearRead (MSArray _ mv) = - INDEX_CHECK("(Mutable S ix e).unsafeLinearRead", Sz . MVS.length, MVS.unsafeRead) mv + unsafeLinearRead (MSArray _sz fp) o = + INDEX_CHECK("(Mutable S ix e).unsafeLinearRead", const (toLinearSz _sz), (unsafeIOToPrim . (`unsafeWithForeignPtr` (`peekElemOff` o)))) fp {-# INLINE unsafeLinearRead #-} - unsafeLinearWrite (MSArray _ mv) = - INDEX_CHECK("(Mutable S ix e).unsafeLinearWrite", Sz . MVS.length, MVS.unsafeWrite) mv + unsafeLinearWrite (MSArray _sz fp) o e = + INDEX_CHECK("(Mutable S ix e).unsafeLinearWrite", const (toLinearSz _sz), (unsafeIOToPrim . (`unsafeWithForeignPtr` (\p -> pokeElemOff p o e)))) fp {-# INLINE unsafeLinearWrite #-} - unsafeLinearSet (MSArray _ mv) i k = VGM.basicSet (MVS.unsafeSlice i (unSz k) mv) + unsafeLinearSet (MSArray _ fp) i k = + MVG.basicSet (MVS.unsafeFromForeignPtr0 (advanceForeignPtr fp i) (unSz k)) {-# INLINE unsafeLinearSet #-} - unsafeLinearCopy marrFrom iFrom marrTo iTo (Sz k) = do - let MSArray _ (MVS.MVector _ fpFrom) = marrFrom - MSArray _ (MVS.MVector _ fpTo) = marrTo + unsafeLinearCopy (MSArray _ fpFrom) iFrom (MSArray _ fpTo) iTo (Sz k) = do unsafePrimToPrim $ withForeignPtr fpFrom $ \ ptrFrom -> withForeignPtr fpTo $ \ ptrTo -> do @@ -180,25 +202,20 @@ instance Storable e => Mutable S e where unsafeLinearCopy marrFrom iFrom marrTo iTo sz {-# INLINE unsafeArrayLinearCopy #-} - unsafeLinearShrink marr@(MSArray _ mv@(MVS.MVector _ (ForeignPtr _ fpc))) sz = do + unsafeLinearShrink marr@(MSArray _ fp@(ForeignPtr _ fpc)) sz = do let shrinkMBA :: MutableByteArray RealWorld -> IO () shrinkMBA mba = shrinkMutableByteArray mba (totalElem sz * sizeOf (undefined :: e)) {-# INLINE shrinkMBA #-} case fpc of MallocPtr mba# _ -> do unsafePrimToPrim $ shrinkMBA (MutableByteArray mba#) - pure $ MSArray sz mv + pure $ MSArray sz fp PlainPtr mba# -> do unsafePrimToPrim $ shrinkMBA (MutableByteArray mba#) - pure $ MSArray sz mv + pure $ MSArray sz fp _ -> unsafeDefaultLinearShrink marr sz {-# INLINE unsafeLinearShrink #-} - unsafeLinearGrow (MSArray oldSz mv) sz = - MSArray sz <$> MVS.unsafeGrow mv (totalElem sz - totalElem oldSz) - {-# INLINE unsafeLinearGrow #-} - - instance (Index ix, Storable e) => Load S ix e where makeArrayLinear !comp !sz f = unsafePerformIO $ generateArrayLinear comp sz (pure . f) {-# INLINE makeArrayLinear #-} @@ -247,69 +264,75 @@ instance (Storable e, IsList (Array L ix e), Ragged L ix e) => IsList (Array S i -- referential transparency. -- -- @since 0.1.3 -unsafeWithPtr :: (MonadUnliftIO m, Storable a) => Array S ix a -> (Ptr a -> m b) -> m b -unsafeWithPtr arr f = withRunInIO $ \run -> VS.unsafeWith (sData arr) (run . f) +unsafeWithPtr :: MonadUnliftIO m => Array S ix e -> (Ptr e -> m b) -> m b +unsafeWithPtr arr f = withRunInIO $ \run -> unsafeWithForeignPtr (sData arr) (run . f) {-# INLINE unsafeWithPtr #-} -- | A pointer to the beginning of the mutable array. -- -- @since 0.1.3 -withPtr :: (MonadUnliftIO m, Storable a) => MArray RealWorld S ix a -> (Ptr a -> m b) -> m b -withPtr (MSArray _ mv) f = withRunInIO $ \run -> MVS.unsafeWith mv (run . f) +withPtr :: MonadUnliftIO m => MArray RealWorld S ix e -> (Ptr e -> m b) -> m b +withPtr (MSArray _ fp) f = withRunInIO $ \run -> unsafeWithForeignPtr fp (run . f) {-# INLINE withPtr #-} -- | /O(1)/ - Unwrap storable array and pull out the underlying storable vector. -- -- @since 0.2.1 -toStorableVector :: Array S ix e -> VS.Vector e -toStorableVector = sData +toStorableVector :: Index ix => Array S ix e -> VS.Vector e +toStorableVector arr = + unsafeCoerce $ -- this hack is needed to workaround redundant Storable constraint + -- see haskell/vector#394 + VS.unsafeFromForeignPtr0 (castForeignPtr (sData arr) :: ForeignPtr Word) (totalElem (sSize arr)) {-# INLINE toStorableVector #-} -- | /O(1)/ - Unwrap storable mutable array and pull out the underlying storable mutable vector. -- -- @since 0.2.1 -toStorableMVector :: MArray s S ix e -> VS.MVector s e -toStorableMVector (MSArray _ mv) = mv +toStorableMVector :: Index ix => MArray s S ix e -> VS.MVector s e +toStorableMVector (MSArray sz fp) = MVS.MVector (totalElem sz) fp {-# INLINE toStorableMVector #-} -- | /O(1)/ - Cast a storable vector to a storable array. -- -- @since 0.5.0 -fromStorableVector :: Storable e => Comp -> VS.Vector e -> Array S Ix1 e -fromStorableVector comp v = SArray {sComp = comp, sSize = SafeSz (VS.length v), sData = v} +fromStorableVector :: Storable e => Comp -> VS.Vector e -> Vector S e +fromStorableVector comp v = + case VS.unsafeToForeignPtr0 v of + (fp, k) -> SArray {sComp = comp, sSize = SafeSz k, sData = fp} {-# INLINE fromStorableVector #-} -- | /O(1)/ - Cast a mutable storable vector to a mutable storable array. -- -- @since 0.5.0 -fromStorableMVector :: MVS.MVector s e -> MArray s S Ix1 e -fromStorableMVector mv@(MVS.MVector len _) = MSArray (SafeSz len) mv +fromStorableMVector :: Storable e => MVS.MVector s e -> MVector s S e +fromStorableMVector mv = + case MVS.unsafeToForeignPtr0 mv of + (fp, k) -> MSArray (SafeSz k) fp {-# INLINE fromStorableMVector #-} -- | /O(1)/ - Yield the underlying `ForeignPtr` together with its length. -- -- @since 0.3.0 -unsafeArrayToForeignPtr :: Storable e => Array S ix e -> (ForeignPtr e, Int) -unsafeArrayToForeignPtr = VS.unsafeToForeignPtr0 . toStorableVector +unsafeArrayToForeignPtr :: Index ix => Array S ix e -> (ForeignPtr e, Int) +unsafeArrayToForeignPtr (SArray _ sz fp) = (fp, totalElem sz) {-# INLINE unsafeArrayToForeignPtr #-} -- | /O(1)/ - Yield the underlying `ForeignPtr` together with its length. -- -- @since 0.3.0 -unsafeMArrayToForeignPtr :: Storable e => MArray s S ix e -> (ForeignPtr e, Int) -unsafeMArrayToForeignPtr = MVS.unsafeToForeignPtr0 . toStorableMVector +unsafeMArrayToForeignPtr :: Index ix => MArray s S ix e -> (ForeignPtr e, Int) +unsafeMArrayToForeignPtr (MSArray sz fp) = (fp, totalElem sz) {-# INLINE unsafeMArrayToForeignPtr #-} -- | /O(1)/ - Wrap a `ForeignPtr` and it's size into a pure storable array. -- -- @since 0.3.0 -unsafeArrayFromForeignPtr0 :: Storable e => Comp -> ForeignPtr e -> Sz1 -> Array S Ix1 e -unsafeArrayFromForeignPtr0 comp ptr sz = - SArray {sComp = comp, sSize = sz, sData = VS.unsafeFromForeignPtr0 ptr (unSz sz)} +unsafeArrayFromForeignPtr0 :: Comp -> ForeignPtr e -> Sz1 -> Vector S e +unsafeArrayFromForeignPtr0 comp fp sz = SArray {sComp = comp, sSize = sz, sData = fp} {-# INLINE unsafeArrayFromForeignPtr0 #-} -- | /O(1)/ - Wrap a `ForeignPtr`, an offset and it's size into a pure storable array. @@ -317,7 +340,7 @@ unsafeArrayFromForeignPtr0 comp ptr sz = -- @since 0.3.0 unsafeArrayFromForeignPtr :: Storable e => Comp -> ForeignPtr e -> Int -> Sz1 -> Array S Ix1 e unsafeArrayFromForeignPtr comp ptr offset sz = - SArray {sComp = comp, sSize = sz, sData = VS.unsafeFromForeignPtr ptr offset (unSz sz)} + SArray {sComp = comp, sSize = sz, sData = advanceForeignPtr ptr offset} {-# INLINE unsafeArrayFromForeignPtr #-} @@ -325,9 +348,8 @@ unsafeArrayFromForeignPtr comp ptr offset sz = -- modify the pointer, unless the array gets frozen prior to modification. -- -- @since 0.3.0 -unsafeMArrayFromForeignPtr0 :: Storable e => ForeignPtr e -> Sz1 -> MArray s S Ix1 e -unsafeMArrayFromForeignPtr0 fp sz = - MSArray sz (MVS.unsafeFromForeignPtr0 fp (unSz sz)) +unsafeMArrayFromForeignPtr0 :: ForeignPtr e -> Sz1 -> MArray s S Ix1 e +unsafeMArrayFromForeignPtr0 fp sz = MSArray sz fp {-# INLINE unsafeMArrayFromForeignPtr0 #-} @@ -336,8 +358,7 @@ unsafeMArrayFromForeignPtr0 fp sz = -- -- @since 0.3.0 unsafeMArrayFromForeignPtr :: Storable e => ForeignPtr e -> Int -> Sz1 -> MArray s S Ix1 e -unsafeMArrayFromForeignPtr fp offset sz = - MSArray sz (MVS.unsafeFromForeignPtr fp offset (unSz sz)) +unsafeMArrayFromForeignPtr fp offset sz = MSArray sz (advanceForeignPtr fp offset) {-# INLINE unsafeMArrayFromForeignPtr #-} @@ -354,5 +375,16 @@ unsafeMallocMArray sz = liftIO $ do foreignPtr <- mask_ $ do ptr <- mallocBytes (sizeOf (undefined :: e) * n) newForeignPtr finalizerFree ptr - pure $ MSArray sz (MVS.unsafeFromForeignPtr0 foreignPtr n) + pure $ MSArray sz foreignPtr {-# INLINE unsafeMallocMArray #-} + + +#if !MIN_VERSION_base(4,15,0) +-- | A compatibility wrapper for 'GHC.ForeignPtr.unsafeWithForeignPtr' provided +-- by GHC 9.0.1 and later. +-- +-- Only to be used when the continuation is known not to +-- unconditionally diverge lest unsoundness can result. +unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b +unsafeWithForeignPtr = withForeignPtr +#endif diff --git a/massiv/src/Data/Massiv/Array/Manifest/Vector.hs b/massiv/src/Data/Massiv/Array/Manifest/Vector.hs index d320347b..b10e156e 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Vector.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Vector.hs @@ -131,7 +131,7 @@ castToVector arr = return $ uData uArr , do Refl <- eqT :: Maybe (r :~: S) sArr <- gcastArr arr - return $ sData sArr + return $ toStorableVector sArr , do Refl <- eqT :: Maybe (r :~: P) pArr <- gcastArr arr return $ VP.Vector (pOffset pArr) (totalElem (size arr)) $ pData pArr diff --git a/massiv/src/Data/Massiv/Core/Common.hs b/massiv/src/Data/Massiv/Core/Common.hs index f5563f8a..e8962512 100644 --- a/massiv/src/Data/Massiv/Core/Common.hs +++ b/massiv/src/Data/Massiv/Core/Common.hs @@ -301,6 +301,8 @@ class (Strategy r, Resize r) => Source r e where -- | /O(1)/ - Take a slice out of an array from the outside + -- + -- @since 0.1.0 unsafeOuterSlice :: (Index ix, Index (Lower ix)) => Array r ix e -> Sz (Lower ix) -> Int -> Array r (Lower ix) e unsafeOuterSlice arr sz i = unsafeResize sz $ unsafeLinearSlice i (toLinearSz sz) arr @@ -402,22 +404,6 @@ class (Strategy r, Shape r ix) => Load r ix e where iterArrayLinearWithSetST_ scheduler arr uWrite _ = iterArrayLinearST_ scheduler arr uWrite {-# INLINE iterArrayLinearWithSetST_ #-} - -- | Load into a supplied mutable array sequentially. Returned array does not have to be - -- the same. - -- - -- @since 1.0.0 - unsafeLoadIntoST' :: - Mutable r' a - => MVector s r' a - -> Array r ix e - -> (e -> ST s a) - -> ST s (MArray s r' ix a) - unsafeLoadIntoST' marr arr f = do - iterArrayLinearWithSetST_ trivialScheduler_ arr (\ix e -> f e >>= unsafeLinearWrite marr ix) - $ \ix sz e -> f e >>= unsafeLinearSet marr ix sz - pure $ unsafeResizeMArray (outerSize arr) marr - {-# INLINE unsafeLoadIntoST' #-} - -- | Load into a supplied mutable array sequentially. Returned array does not have to be -- the same. -- From ac9dac411af7209fbd1a3202674461a8b24e657b Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sun, 25 Jul 2021 00:57:01 +0300 Subject: [PATCH 40/65] Fix couple of bugs introduced in previous commits. All tests pass now. --- massiv-test/tests/Test/Massiv/VectorSpec.hs | 2 +- .../Data/Massiv/Array/Manifest/Storable.hs | 26 +++++++++---------- .../src/Data/Massiv/Array/Manifest/Vector.hs | 2 +- massiv/src/Data/Massiv/Array/Ops/Map.hs | 12 +++++---- 4 files changed, 22 insertions(+), 20 deletions(-) diff --git a/massiv-test/tests/Test/Massiv/VectorSpec.hs b/massiv-test/tests/Test/Massiv/VectorSpec.hs index c6e70f59..6042ebb2 100644 --- a/massiv-test/tests/Test/Massiv/VectorSpec.hs +++ b/massiv-test/tests/Test/Massiv/VectorSpec.hs @@ -1084,7 +1084,7 @@ 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 :: SeedVector -> Vector P 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)) diff --git a/massiv/src/Data/Massiv/Array/Manifest/Storable.hs b/massiv/src/Data/Massiv/Array/Manifest/Storable.hs index 7b9ff67c..a759f546 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Storable.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Storable.hs @@ -120,7 +120,7 @@ instance Storable e => Source S e where {-# INLINE unsafeOuterSlice #-} unsafeLinearSlice i k (SArray c _ fp) = - SArray c k $ advanceForeignPtr fp (i * unSz k) + SArray c k $ advanceForeignPtr fp i {-# INLINE unsafeLinearSlice #-} instance Index ix => Shape S ix where @@ -176,12 +176,12 @@ instance Storable e => Mutable S e where setPtr (castPtr p) (totalElem sz * sizeOf (undefined :: e)) (0 :: Word8) {-# INLINE initialize #-} - unsafeLinearRead (MSArray _sz fp) o = - INDEX_CHECK("(Mutable S ix e).unsafeLinearRead", const (toLinearSz _sz), (unsafeIOToPrim . (`unsafeWithForeignPtr` (`peekElemOff` o)))) fp + unsafeLinearRead (MSArray _sz fp) o = unsafeIOToPrim $ + INDEX_CHECK("(Mutable S ix e).unsafeLinearRead", const (toLinearSz _sz), (\_ _ -> unsafeWithForeignPtr fp (`peekElemOff` o))) fp o {-# INLINE unsafeLinearRead #-} - unsafeLinearWrite (MSArray _sz fp) o e = - INDEX_CHECK("(Mutable S ix e).unsafeLinearWrite", const (toLinearSz _sz), (unsafeIOToPrim . (`unsafeWithForeignPtr` (\p -> pokeElemOff p o e)))) fp + unsafeLinearWrite (MSArray _sz fp) o e = unsafeIOToPrim $ + INDEX_CHECK("(Mutable S ix e).unsafeLinearWrite", const (toLinearSz _sz), (\_ _ -> unsafeWithForeignPtr fp (\p -> pokeElemOff p o e))) fp o {-# INLINE unsafeLinearWrite #-} unsafeLinearSet (MSArray _ fp) i k = @@ -282,7 +282,7 @@ withPtr (MSArray _ fp) f = withRunInIO $ \run -> unsafeWithForeignPtr fp (run . -- @since 0.2.1 toStorableVector :: Index ix => Array S ix e -> VS.Vector e toStorableVector arr = - unsafeCoerce $ -- this hack is needed to workaround redundant Storable constraint + unsafeCoerce $ -- this hack is needed to workaround the redundant Storable constraint -- see haskell/vector#394 VS.unsafeFromForeignPtr0 (castForeignPtr (sData arr) :: ForeignPtr Word) (totalElem (sSize arr)) {-# INLINE toStorableVector #-} @@ -298,19 +298,19 @@ toStorableMVector (MSArray sz fp) = MVS.MVector (totalElem sz) fp -- | /O(1)/ - Cast a storable vector to a storable array. -- -- @since 0.5.0 -fromStorableVector :: Storable e => Comp -> VS.Vector e -> Vector S e +fromStorableVector :: Comp -> VS.Vector e -> Vector S e fromStorableVector comp v = - case VS.unsafeToForeignPtr0 v of - (fp, k) -> SArray {sComp = comp, sSize = SafeSz k, sData = fp} + -- unasfeCoerce hack below is needed to workaround the redundant Storable + -- constraint see haskell/vector#394 + case VS.unsafeToForeignPtr0 (unsafeCoerce v :: VS.Vector Word) of + (fp, k) -> SArray {sComp = comp, sSize = SafeSz k, sData = castForeignPtr fp} {-# INLINE fromStorableVector #-} -- | /O(1)/ - Cast a mutable storable vector to a mutable storable array. -- -- @since 0.5.0 -fromStorableMVector :: Storable e => MVS.MVector s e -> MVector s S e -fromStorableMVector mv = - case MVS.unsafeToForeignPtr0 mv of - (fp, k) -> MSArray (SafeSz k) fp +fromStorableMVector :: MVS.MVector s e -> MVector s S e +fromStorableMVector (MVS.MVector n fp) = MSArray (SafeSz n) fp {-# INLINE fromStorableMVector #-} diff --git a/massiv/src/Data/Massiv/Array/Manifest/Vector.hs b/massiv/src/Data/Massiv/Array/Manifest/Vector.hs index b10e156e..334147d8 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Vector.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Vector.hs @@ -73,7 +73,7 @@ castFromVector comp sz vector = do return $ UArray {uComp = comp, uSize = sz, uData = uVector} , do Refl <- eqT :: Maybe (v :~: VS.Vector) sVector <- join $ gcast1 (Just vector) - return $ SArray {sComp = comp, sSize = sz, sData = sVector} + return $ unsafeResize sz $ fromStorableVector comp sVector , do Refl <- eqT :: Maybe (v :~: VP.Vector) VP.Vector o _ ba <- join $ gcast1 (Just vector) return $ PArray {pComp = comp, pSize = sz, pOffset = o, pData = ba} diff --git a/massiv/src/Data/Massiv/Array/Ops/Map.hs b/massiv/src/Data/Massiv/Array/Ops/Map.hs index 8e7e44ef..102437dc 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Map.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Map.hs @@ -561,7 +561,9 @@ imapIO_ action arr = withRunInIO $ \run -> withMassivScheduler_ (getComp arr) $ \scheduler -> let sz = outerSize arr - -- It is ok to user outerSize in context of DS (never evaluated) and L as well + -- It is ok to use outerSize in context of DS and L. Former is 1-dim, + -- so sz is never evaluated and for the latter outerSize has to be + -- called regardless how this function is implemented. in iterArrayLinearM_ scheduler arr (\i -> void . run . action (fromLinearIndex sz i)) {-# INLINE imapIO_ #-} @@ -575,12 +577,12 @@ imapIO :: -> Array r' ix a -> m (Array r ix b) imapIO action arr = do + let sz = size arr withRunInIO $ \run -> do - marr <- unsafeNew $ size arr + marr <- unsafeNew sz withMassivScheduler_ (getComp arr) $ \scheduler -> - let sz = outerSize arr - -- It is ok to user outerSize in context of DS (never evaluated) and L as well - in iterArrayLinearM_ scheduler arr (\i -> void . run . action (fromLinearIndex sz i)) + iterArrayLinearM_ scheduler arr $ \ !i e -> + run (action (fromLinearIndex sz i) e) >>= unsafeLinearWrite marr i unsafeFreeze (getComp arr) marr {-# INLINE imapIO #-} From 36a2d96e72a0b814fbbd406204c337013697fe3b Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sun, 25 Jul 2021 01:41:28 +0300 Subject: [PATCH 41/65] Attempt to fix doctests --- massiv/src/Data/Massiv/Array/Manifest/Storable.hs | 6 +++--- massiv/src/Data/Massiv/Array/Mutable.hs | 1 + massiv/src/Data/Massiv/Array/Ops/Construct.hs | 8 ++++---- 3 files changed, 8 insertions(+), 7 deletions(-) diff --git a/massiv/src/Data/Massiv/Array/Manifest/Storable.hs b/massiv/src/Data/Massiv/Array/Manifest/Storable.hs index a759f546..8f9d735c 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Storable.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Storable.hs @@ -367,10 +367,10 @@ unsafeMArrayFromForeignPtr fp offset sz = MSArray sz (advanceForeignPtr fp offse -- -- @since 0.5.9 unsafeMallocMArray :: - forall ix e m. (Index ix, Storable e, MonadIO m) + forall ix e m. (Index ix, Storable e, PrimMonad m) => Sz ix - -> m (MArray RealWorld S ix e) -unsafeMallocMArray sz = liftIO $ do + -> m (MArray (PrimState m) S ix e) +unsafeMallocMArray sz = unsafePrimToPrim $ do let n = totalElem sz foreignPtr <- mask_ $ do ptr <- mallocBytes (sizeOf (undefined :: e) * n) diff --git a/massiv/src/Data/Massiv/Array/Mutable.hs b/massiv/src/Data/Massiv/Array/Mutable.hs index 1e98da65..56dae76c 100644 --- a/massiv/src/Data/Massiv/Array/Mutable.hs +++ b/massiv/src/Data/Massiv/Array/Mutable.hs @@ -154,6 +154,7 @@ outerSliceMArrayM !marr !i = do -- -- ====__Examples__ -- +-- >>> import Data.Massiv.Array as A -- >>> arr <- resizeM (Sz2 4 7) $ makeArrayR P Seq (Sz1 28) (+10) -- >>> arr -- Array P Seq (Sz (4 :. 7)) diff --git a/massiv/src/Data/Massiv/Array/Ops/Construct.hs b/massiv/src/Data/Massiv/Array/Ops/Construct.hs index 9a8cc101..3f3858b3 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Construct.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Construct.hs @@ -427,19 +427,19 @@ randomArrayS gen sz nextRandom = -- >>> import System.Random.Stateful (uniformRM) -- >>> import Control.Scheduler (initWorkerStates, getWorkerId) -- >>> :set -XTypeApplications --- >>> gens <- initWorkerStates Par (MWC.initialize . A.toPrimitiveVector . A.singleton @P @Ix1 . fromIntegral . getWorkerId) +-- >>> gens <- initWorkerStates Seq (MWC.initialize . A.toPrimitiveVector . A.singleton @P @Ix1 . fromIntegral . getWorkerId) -- >>> randomArrayWS gens (Sz2 2 3) (uniformRM (0, 9)) :: IO (Matrix P Double) --- Array P Par (Sz (2 :. 3)) +-- Array P Seq (Sz (2 :. 3)) -- [ [ 2.5438514691269685, 4.287612444807011, 5.610339021582389 ] -- , [ 4.697970155404468, 5.00119167394813, 2.996037154611197 ] -- ] -- >>> randomArrayWS gens (Sz2 2 3) (uniformRM (0, 9)) :: IO (Matrix P Double) --- Array P Par (Sz (2 :. 3)) +-- Array P Seq (Sz (2 :. 3)) -- [ [ 2.3381558618288985, 5.950737336743302, 2.30528055886831 ] -- , [ 6.537992271897603, 7.83182061304764, 4.17882094946732 ] -- ] -- >>> randomArrayWS gens (Sz1 6) (uniformRM (0, 9)) :: IO (Vector P Int) --- Array P Par (Sz1 6) +-- Array P Seq (Sz1 6) -- [ 7, 6, 7, 7, 5, 3 ] -- -- @since 0.3.4 From 1a7dee4cec1f6770cfac5e5a0e85d3733fb324f7 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sun, 25 Jul 2021 03:02:58 +0300 Subject: [PATCH 42/65] Fix outerSliceMArrayM and improve Eq instance of exceptions by using Typeable --- massiv-test/src/Test/Massiv/Array/Mutable.hs | 18 ++++++- massiv-test/src/Test/Massiv/Core/Mutable.hs | 2 - .../tests/Test/Massiv/Array/MutableSpec.hs | 50 ++++++++++++++++++- .../tests/Test/Massiv/Core/IndexSpec.hs | 7 +-- massiv/src/Data/Massiv/Array/Mutable.hs | 2 +- massiv/src/Data/Massiv/Core/Index/Internal.hs | 40 +++++++++------ 6 files changed, 92 insertions(+), 27 deletions(-) diff --git a/massiv-test/src/Test/Massiv/Array/Mutable.hs b/massiv-test/src/Test/Massiv/Array/Mutable.hs index d77fe187..66b0fdce 100644 --- a/massiv-test/src/Test/Massiv/Array/Mutable.hs +++ b/massiv-test/src/Test/Massiv/Array/Mutable.hs @@ -177,6 +177,22 @@ prop_WithMArray arr f g = let arr6 = withLoadMArrayST_ (A.map (applyFun f) arr) $ \marr -> forPrimM marr g' arr6 `shouldBe` arr' +prop_unsafeLinearSliceMArray :: + forall r ix e. (HasCallStack, Index ix, Mutable r e, Eq (Vector r e), Show (Vector r e)) + => Array r ix e + -> Property +prop_unsafeLinearSliceMArray arr = + forAll genLinearRegion $ \(i, k) -> + propIO $ do + marr <- thawS arr + unsafeFreeze Seq (unsafeLinearSliceMArray i k marr) `shouldReturn` unsafeLinearSlice i k arr + where + n = totalElem (size arr) + genLinearRegion = do + k <- chooseInt (0, n) + i <- chooseInt (0, n - k) + pure (i, Sz k) + mutableSpec :: forall r ix e. ( Show (Array D ix e) @@ -193,7 +209,6 @@ mutableSpec :: , Arbitrary e , CoArbitrary e , Arbitrary ix - , Typeable ix , Function ix , Function e ) @@ -205,6 +220,7 @@ mutableSpec = do prop "GrowShrink" $ prop_GrowShrink @r @ix @e prop "map == mapM" $ prop_iMapiMapM @r @ix @e prop "withMArray" $ prop_WithMArray @r @ix @e + prop "unsafeLinearSliceMArray == unsafeLinearSlice" $ prop_unsafeLinearSliceMArray @r @ix @e describe "Unfolding" $ do it "unfoldrList" $ prop_unfoldrList @r @ix @e it "unfoldrReverseUnfoldl" $ prop_unfoldrReverseUnfoldl @r @ix @e diff --git a/massiv-test/src/Test/Massiv/Core/Mutable.hs b/massiv-test/src/Test/Massiv/Core/Mutable.hs index e83340fa..7ca412f5 100644 --- a/massiv-test/src/Test/Massiv/Core/Mutable.hs +++ b/massiv-test/src/Test/Massiv/Core/Mutable.hs @@ -251,7 +251,6 @@ unsafeMutableSpec :: , Arbitrary e , Arbitrary ix , Typeable e - , Typeable ix ) => Spec unsafeMutableSpec = @@ -271,7 +270,6 @@ unsafeMutableSpec = unsafeMutableUnboxedSpec :: forall r ix e. ( Typeable e - , Typeable ix , Eq (Array r ix e) , Show (Array r ix e) , Index ix diff --git a/massiv-test/tests/Test/Massiv/Array/MutableSpec.hs b/massiv-test/tests/Test/Massiv/Array/MutableSpec.hs index f6bf24eb..63ff31ea 100644 --- a/massiv-test/tests/Test/Massiv/Array/MutableSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/MutableSpec.hs @@ -24,8 +24,8 @@ type MutableArraySpec r ix e , Function e , Eq (Array r ix e) , Show (Array r ix e) - , Eq (Array r Ix1 e) - , Show (Array r Ix1 e) + , Eq (Vector r e) + , Show (Vector r e) , Load r ix e , Resize r , Arbitrary (Array r ix e) @@ -68,10 +68,32 @@ specMutableR = do localMutableSpec @r @Ix3 @e localMutableSpec @r @Ix4 @e localMutableSpec @r @Ix5 @e + describe "NonFlat" $ do + specMutableNonFlatR @r @Ix2 @e + specMutableNonFlatR @r @Ix3 @e + specMutableNonFlatR @r @Ix4 @e + specMutableNonFlatR @r @Ix5 @e describe "toStream/toList" $ it "toStreamIsList" $ property (prop_toStreamIsList @r @e) --mutableSpec @r @Ix5 @e -- slows down the test suite +specMutableNonFlatR :: + forall r ix e. + ( Arbitrary ix + , Typeable e + , Arbitrary e + , Index (Lower ix) + , Load r ix e + , Mutable r e + , Eq (Array r (Lower ix) e) + , Show (Array r (Lower ix) e) + , Show (Array r ix e) + ) + => Spec +specMutableNonFlatR = do + describe (showsArrayType @r @ix @e "") $ + prop "outerSliceMArrayM" $ prop_outerSliceMArrayM @r @ix @ e + specUnboxedMutableR :: forall r e. MutableSpec r e => Spec specUnboxedMutableR = do @@ -196,6 +218,30 @@ prop_Swap arr ix1 ix2 = index' arr'' ix2 `shouldBe` e1 +prop_outerSliceMArrayM :: + forall r ix e. + ( Index ix + , Index (Lower ix) + , Mutable r e + , Eq (Array r (Lower ix) e) + , Show (Array r (Lower ix) e) + ) + => ArrNE r ix e + -> Property +prop_outerSliceMArrayM (ArrNE arr) = + forAll genIxInAndOut $ \(iIn, iOut) -> + propIO $ do + marr <- thawS arr + (outerSliceMArrayM marr iIn >>= freezeS) `shouldReturn` arr !> iIn + outerSliceMArrayM marr iOut `shouldThrow` (== IndexOutOfBoundsException (Sz nOuter) iOut) + where + (Sz nOuter, _) = unconsSz $ size arr + genIxInAndOut = do + let n = max 0 (nOuter - 1) + iIn <- chooseInt (0, n) + iOut <- oneof [chooseInt (minBound, -1), chooseInt (n, maxBound)] + pure (iIn, iOut) + spec :: Spec spec = do diff --git a/massiv-test/tests/Test/Massiv/Core/IndexSpec.hs b/massiv-test/tests/Test/Massiv/Core/IndexSpec.hs index 02e69058..3ac4be14 100644 --- a/massiv-test/tests/Test/Massiv/Core/IndexSpec.hs +++ b/massiv-test/tests/Test/Massiv/Core/IndexSpec.hs @@ -24,8 +24,6 @@ specIxN :: , Index ix , Bounded ix , Index (Lower ix) - , Typeable ix - , Typeable (Lower ix) , Arbitrary ix , Arbitrary (Lower ix) , IsIndexDimension ix (Dimensions ix) @@ -67,9 +65,7 @@ specIxN = do specIxT :: forall ix ix'. - ( Typeable ix - , Typeable (Lower ix) - , Index ix + ( Index ix , Index (Lower ix) , Arbitrary ix , Arbitrary (Lower ix) @@ -133,7 +129,6 @@ specSz :: ( Num ix -- , Unbox ix -- TODO: add Unbox instance and a spec for unboxed vectors , Index ix - , Typeable ix , Arbitrary ix ) => Spec diff --git a/massiv/src/Data/Massiv/Array/Mutable.hs b/massiv/src/Data/Massiv/Array/Mutable.hs index 56dae76c..38591526 100644 --- a/massiv/src/Data/Massiv/Array/Mutable.hs +++ b/massiv/src/Data/Massiv/Array/Mutable.hs @@ -144,7 +144,7 @@ outerSliceMArrayM :: outerSliceMArrayM !marr !i = do let (k, szL) = unconsSz (sizeOfMArray marr) unless (isSafeIndex k i) $ throwM $ IndexOutOfBoundsException k i - pure $ unsafeResizeMArray szL $ unsafeLinearSliceMArray i (toLinearSz szL) marr + pure $ unsafeResizeMArray szL $ unsafeLinearSliceMArray (i * totalElem szL) (toLinearSz szL) marr {-# INLINE outerSliceMArrayM #-} -- | /O(1)/ - Take all outer slices of a mutable array and construct a delayed diff --git a/massiv/src/Data/Massiv/Core/Index/Internal.hs b/massiv/src/Data/Massiv/Core/Index/Internal.hs index dc6cef55..eb76efbf 100644 --- a/massiv/src/Data/Massiv/Core/Index/Internal.hs +++ b/massiv/src/Data/Massiv/Core/Index/Internal.hs @@ -412,6 +412,7 @@ class ( Eq ix , Ord ix , Show ix , NFData ix + , Typeable ix , Eq (Lower ix) , Ord (Lower ix) , Show (Lower ix) @@ -733,7 +734,7 @@ data IndexException where -- | Index contains a zero value along one of the dimensions. IndexZeroException :: Index ix => !ix -> IndexException -- | Dimension is out of reach. - IndexDimensionException :: (NFData ix, Show ix, Typeable ix) => !ix -> !Dim -> IndexException + IndexDimensionException :: (NFData ix, Eq ix, Show ix, Typeable ix) => !ix -> !Dim -> IndexException -- | Index is out of bounds. IndexOutOfBoundsException :: Index ix => !(Sz ix) -> !ix -> IndexException @@ -748,11 +749,13 @@ instance Show IndexException where instance Eq IndexException where e1 == e2 = case (e1, e2) of - (IndexZeroException i1, IndexZeroException i2) -> show i1 == show i2 - (IndexDimensionException i1 d1, IndexDimensionException i2 d2) -> - show i1 == show i2 && d1 == d2 - (IndexOutOfBoundsException sz1 i1, IndexOutOfBoundsException sz2 i2) -> - show sz1 == show sz2 && show i1 == show i2 + (IndexZeroException i1, IndexZeroException i2t) + | Just i2 <- cast i2t -> i1 == i2 + (IndexDimensionException i1 d1, IndexDimensionException i2t d2) + | Just i2 <- cast i2t -> i1 == i2 && d1 == d2 + (IndexOutOfBoundsException sz1 i1, IndexOutOfBoundsException sz2t i2t) + | Just i2 <- cast i2t + , Just sz2 <- cast sz2t -> sz1 == sz2 && i1 == i2 _ -> False instance NFData IndexException where @@ -788,15 +791,22 @@ data SizeException where instance Eq SizeException where e1 == e2 = case (e1, e2) of - (SizeMismatchException sz1 sz1', SizeMismatchException sz2 sz2') -> - show sz1 == show sz2 && show sz1' == show sz2' - (SizeElementsMismatchException sz1 sz1', SizeElementsMismatchException sz2 sz2') -> - show sz1 == show sz2 && show sz1' == show sz2' - (SizeSubregionException sz1 i1 sz1', SizeSubregionException sz2 i2 sz2') -> - show sz1 == show sz2 && show i1 == show i2 && show sz1' == show sz2' - (SizeEmptyException sz1, SizeEmptyException sz2) -> show sz1 == show sz2 - (SizeOverflowException sz1, SizeOverflowException sz2) -> show sz1 == show sz2 - (SizeNegativeException sz1, SizeNegativeException sz2) -> show sz1 == show sz2 + (SizeMismatchException sz1 sz1', SizeMismatchException sz2t sz2t') + | Just sz2 <- cast sz2t + , Just sz2' <- cast sz2t' -> sz1 == sz2 && sz1' == sz2' + (SizeElementsMismatchException sz1 sz1', SizeElementsMismatchException sz2t sz2t') + | Just sz2 <- cast sz2t + , Just sz2' <- cast sz2t' -> sz1 == sz2 && sz1' == sz2' + (SizeSubregionException sz1 i1 sz1', SizeSubregionException sz2t i2t sz2t') + | Just sz2 <- cast sz2t + , Just i2 <- cast i2t + , Just sz2' <- cast sz2t' -> sz1 == sz2 && i1 == i2 && sz1' == sz2' + (SizeEmptyException sz1, SizeEmptyException sz2t) + | Just sz2 <- cast sz2t -> sz1 == sz2 + (SizeOverflowException sz1, SizeOverflowException sz2t) + | Just sz2 <- cast sz2t -> sz1 == sz2 + (SizeNegativeException sz1, SizeNegativeException sz2t) + | Just sz2 <- cast sz2t -> sz1 == sz2 _ -> False instance NFData SizeException where From 0c621d42bd106b2ac70a2c946461ac4e155fa53d Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sun, 25 Jul 2021 03:20:07 +0300 Subject: [PATCH 43/65] Fix doctests --- massiv-test/tests/Test/Massiv/VectorSpec.hs | 2 +- massiv/src/Data/Massiv/Array/Ops/Construct.hs | 17 ++++++----------- 2 files changed, 7 insertions(+), 12 deletions(-) diff --git a/massiv-test/tests/Test/Massiv/VectorSpec.hs b/massiv-test/tests/Test/Massiv/VectorSpec.hs index 6042ebb2..c6e70f59 100644 --- a/massiv-test/tests/Test/Massiv/VectorSpec.hs +++ b/massiv-test/tests/Test/Massiv/VectorSpec.hs @@ -1084,7 +1084,7 @@ 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 P Word -> Property +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)) diff --git a/massiv/src/Data/Massiv/Array/Ops/Construct.hs b/massiv/src/Data/Massiv/Array/Ops/Construct.hs index 3f3858b3..5f3be998 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Construct.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Construct.hs @@ -427,20 +427,15 @@ randomArrayS gen sz nextRandom = -- >>> import System.Random.Stateful (uniformRM) -- >>> import Control.Scheduler (initWorkerStates, getWorkerId) -- >>> :set -XTypeApplications --- >>> gens <- initWorkerStates Seq (MWC.initialize . A.toPrimitiveVector . A.singleton @P @Ix1 . fromIntegral . getWorkerId) +-- >>> gens <- initWorkerStates Par (MWC.initialize . A.toPrimitiveVector . A.singleton @P @Ix1 . fromIntegral . getWorkerId) -- >>> randomArrayWS gens (Sz2 2 3) (uniformRM (0, 9)) :: IO (Matrix P Double) --- Array P Seq (Sz (2 :. 3)) --- [ [ 2.5438514691269685, 4.287612444807011, 5.610339021582389 ] --- , [ 4.697970155404468, 5.00119167394813, 2.996037154611197 ] --- ] --- >>> randomArrayWS gens (Sz2 2 3) (uniformRM (0, 9)) :: IO (Matrix P Double) --- Array P Seq (Sz (2 :. 3)) --- [ [ 2.3381558618288985, 5.950737336743302, 2.30528055886831 ] --- , [ 6.537992271897603, 7.83182061304764, 4.17882094946732 ] +-- Array P Par (Sz (2 :. 3)) +-- [ [ 8.999240522095299, 6.832223390653755, 3.065728078741671 ] +-- , [ 7.242581103346686, 2.4565807301968623, 0.4514262066689775 ] -- ] -- >>> randomArrayWS gens (Sz1 6) (uniformRM (0, 9)) :: IO (Vector P Int) --- Array P Seq (Sz1 6) --- [ 7, 6, 7, 7, 5, 3 ] +-- Array P Par (Sz1 6) +-- [ 8, 8, 7, 1, 1, 2 ] -- -- @since 0.3.4 randomArrayWS :: From c35a0cde87525b141e3dbd16d623549d9b5fd658 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sun, 25 Jul 2021 18:05:08 +0300 Subject: [PATCH 44/65] Add couple more tests. Remove compatibility with old primitive. --- massiv-examples/GameOfLife/app/GameOfLife.hs | 4 +- massiv-examples/stack.yaml | 15 ++--- massiv-test/massiv-test.cabal | 1 + massiv-test/src/Test/Massiv/Array/Load.hs | 66 +++++++++++++++++++ massiv-test/src/Test/Massiv/Array/Mutable.hs | 21 +----- massiv-test/src/Test/Massiv/Core/Mutable.hs | 40 +++++++---- .../Test/Massiv/Array/Delayed/StreamSpec.hs | 10 ++- .../tests/Test/Massiv/Array/MutableSpec.hs | 22 ++++--- .../src/Data/Massiv/Array/Manifest/Boxed.hs | 22 ++----- .../Data/Massiv/Array/Manifest/Internal.hs | 18 ----- .../Data/Massiv/Array/Manifest/Primitive.hs | 26 +------- stack-extra-deps.yaml | 2 +- 12 files changed, 136 insertions(+), 111 deletions(-) create mode 100644 massiv-test/src/Test/Massiv/Array/Load.hs diff --git a/massiv-examples/GameOfLife/app/GameOfLife.hs b/massiv-examples/GameOfLife/app/GameOfLife.hs index 41bfed5c..e5ee90cc 100644 --- a/massiv-examples/GameOfLife/app/GameOfLife.hs +++ b/massiv-examples/GameOfLife/app/GameOfLife.hs @@ -111,14 +111,14 @@ drawLife :: Int -> MArray RealWorld S Ix2 Word8 -> Array S Ix2 Word8 -> IO () drawLife s mArr arr = do computeInto mArr $ pixelGrid s arr A.withPtr mArr $ \ptr -> - drawPixels (sizeFromSz2 (msize mArr)) (PixelData Luminance UnsignedByte ptr) + drawPixels (sizeFromSz2 (sizeOfMArray mArr)) (PixelData Luminance UnsignedByte ptr) drawLifeStep :: Int -> MArray RealWorld S Ix2 Word8 -> Array D Ix2 (Word8, Word8) -> IO () drawLifeStep s mArr arr = do imapM_ updateCellLife arr A.withPtr mArr $ \ptr -> - drawPixels (sizeFromSz2 (msize mArr)) (PixelData Luminance UnsignedByte ptr) + drawPixels (sizeFromSz2 (sizeOfMArray mArr)) (PixelData Luminance UnsignedByte ptr) where k = s + 1 updateCellLife (i :. j) (prev, next) = diff --git a/massiv-examples/stack.yaml b/massiv-examples/stack.yaml index 31477c58..42efb137 100644 --- a/massiv-examples/stack.yaml +++ b/massiv-examples/stack.yaml @@ -1,5 +1,4 @@ -resolver: lts-16.31 - +resolver: lts-18.3 packages: - GameOfLife - vision @@ -7,14 +6,12 @@ packages: extra-deps: - ../massiv - github: lehins/massiv-io - commit: d5cc91fd11383d8597489dcb00b28e93e5883787 + commit: 45ab3265b50f792daafefa8d9b686483fb058538 subdirs: - massiv-io -- Color-0.3.1@sha256:980a3869e25cbe91275113dd3273465e373b06d710c9e4ef3e0f07ec77815165,8193 -#- massiv-io-0.4.1.0@sha256:fd1db3d851e0343833b8b3b6526be0f05782ee1f2152788616d71108d3b9676f,3667 -- scheduler-1.5.0@sha256:8b43f2991bf9a720b12192ba99525f705a44aeae9541a7bd73fbc7e7b56fd8f0,2437 -- random-1.2.0@sha256:5ca8674e95c46c7eb90f520c26aea22d403625c97697275434afba66ebd32b05,5897 -- splitmix-0.1.0.3@sha256:fc3aae74c467f4b608050bef53aec17904a618731df9407e655d8f3bf8c32d5c,6049 -- QuickCheck-2.14.1@sha256:01e46d7b0a8d3148288ec977625f62d5516ebb5031a50c63f0453863301b4a79,7736 +- github: lehins/haskell-scheduler + commit: c5506d20d96fc3fb00c213791243b7246d39e822 + subdirs: + - scheduler nix: packages: [ zlib libGLU ] diff --git a/massiv-test/massiv-test.cabal b/massiv-test/massiv-test.cabal index 023be51b..c770a604 100644 --- a/massiv-test/massiv-test.cabal +++ b/massiv-test/massiv-test.cabal @@ -21,6 +21,7 @@ library , Test.Massiv.Core.Index , Test.Massiv.Core.Mutable , Test.Massiv.Array.Delayed + , Test.Massiv.Array.Load , Test.Massiv.Array.Mutable , Test.Massiv.Array.Numeric , Test.Massiv.Utils diff --git a/massiv-test/src/Test/Massiv/Array/Load.hs b/massiv-test/src/Test/Massiv/Array/Load.hs new file mode 100644 index 00000000..94f07b99 --- /dev/null +++ b/massiv-test/src/Test/Massiv/Array/Load.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MonoLocalBinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +module Test.Massiv.Array.Load + ( -- * Spec for loadable representations + 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 + , Show e + , Load r ix e + , Ragged L ix e + ) + => Comp + -> Sz ix + -> 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)) + +prop_makeArray :: + forall r ix e. + ( Eq e + , Show e + , Load r ix e + , Ragged L ix e + ) + => Comp + -> Sz ix + -> Fun ix e + -> Property +prop_makeArray comp sz f = propIO $ do + let barr = makeArray @B comp sz (applyFun f) + 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 + , Show e + , Typeable e + , Arbitrary e + , Function ix + , Arbitrary ix + , CoArbitrary ix + , Ragged L ix e + , Load r ix e + ) + => Spec +loadSpec = do + describe (("LoadSpec " ++) . showsArrayType @r @ix @e $ "") $ do + prop "replicate" $ prop_replicate @r @ix @e + prop "makeArray" $ prop_makeArray @r @ix @e diff --git a/massiv-test/src/Test/Massiv/Array/Mutable.hs b/massiv-test/src/Test/Massiv/Array/Mutable.hs index 66b0fdce..cc66bf7b 100644 --- a/massiv-test/src/Test/Massiv/Array/Mutable.hs +++ b/massiv-test/src/Test/Massiv/Array/Mutable.hs @@ -177,28 +177,12 @@ prop_WithMArray arr f g = let arr6 = withLoadMArrayST_ (A.map (applyFun f) arr) $ \marr -> forPrimM marr g' arr6 `shouldBe` arr' -prop_unsafeLinearSliceMArray :: - forall r ix e. (HasCallStack, Index ix, Mutable r e, Eq (Vector r e), Show (Vector r e)) - => Array r ix e - -> Property -prop_unsafeLinearSliceMArray arr = - forAll genLinearRegion $ \(i, k) -> - propIO $ do - marr <- thawS arr - unsafeFreeze Seq (unsafeLinearSliceMArray i k marr) `shouldReturn` unsafeLinearSlice i k arr - where - n = totalElem (size arr) - genLinearRegion = do - k <- chooseInt (0, n) - i <- chooseInt (0, n - k) - pure (i, Sz k) - mutableSpec :: forall r ix e. ( Show (Array D ix e) , Show (Array r ix e) - , Show (Array r Ix1 e) - , Eq (Array r Ix1 e) + , Show (Vector r e) + , Eq (Vector r e) , Load r ix e , Eq (Array r ix e) , Typeable e @@ -220,7 +204,6 @@ mutableSpec = do prop "GrowShrink" $ prop_GrowShrink @r @ix @e prop "map == mapM" $ prop_iMapiMapM @r @ix @e prop "withMArray" $ prop_WithMArray @r @ix @e - prop "unsafeLinearSliceMArray == unsafeLinearSlice" $ prop_unsafeLinearSliceMArray @r @ix @e describe "Unfolding" $ do it "unfoldrList" $ prop_unfoldrList @r @ix @e it "unfoldrReverseUnfoldl" $ prop_unfoldrReverseUnfoldl @r @ix @e diff --git a/massiv-test/src/Test/Massiv/Core/Mutable.hs b/massiv-test/src/Test/Massiv/Core/Mutable.hs index 7ca412f5..eb5fe43b 100644 --- a/massiv-test/src/Test/Massiv/Core/Mutable.hs +++ b/massiv-test/src/Test/Massiv/Core/Mutable.hs @@ -238,6 +238,23 @@ prop_UnsafeLinearGrow (ArrIx arr ix) e = (,) <$> unsafeFreeze (getComp arr) marrCopied <*> unsafeFreeze (getComp arr) marrGrown +prop_UnsafeLinearSliceMArray :: + forall r ix e. (HasCallStack, Index ix, Mutable r e, Eq (Vector r e), Show (Vector r e)) + => Array r ix e + -> Property +prop_UnsafeLinearSliceMArray arr = + forAll genLinearRegion $ \(i, k) -> + propIO $ do + marr <- thawS arr + unsafeFreeze Seq (unsafeLinearSliceMArray i k marr) `shouldReturn` unsafeLinearSlice i k arr + where + n = totalElem (size arr) + genLinearRegion = do + k <- chooseInt (0, n) + i <- chooseInt (0, n - k) + pure (i, Sz k) + + unsafeMutableSpec :: forall r ix e. ( Eq (Vector r e) @@ -255,17 +272,18 @@ unsafeMutableSpec :: => Spec unsafeMutableSpec = describe ("Mutable (" ++ showsArrayType @r @ix @e ") (Unsafe)") $ do - it "UnsafeNewMsize" $ prop_UnsafeNewMsize @r @ix @e - it "UnsafeNewLinearWriteRead" $ prop_UnsafeNewLinearWriteRead @r @ix @e - it "UnsafeThawFreeze" $ property $ prop_UnsafeThawFreeze @r @ix @e - it "UnsafeInitializeNew" $ prop_UnsafeInitializeNew @r @ix @e - it "UnsafeLinearSet" $ property $ prop_UnsafeLinearSet @r @ix @e - it "UnsafeLinearCopy" $ property $ prop_UnsafeLinearCopy @r @ix @e - it "UnsafeLinearCopyPart" $ property $ prop_UnsafeLinearCopyPart @r @ix @e - it "UnsafeArrayLinearCopy" $ property $ prop_UnsafeArrayLinearCopy @r @ix @e - it "UnsafeArrayLinearCopyPart" $ property $ prop_UnsafeArrayLinearCopyPart @r @ix @e - it "UnsafeLinearShrink" $ property $ prop_UnsafeLinearShrink @r @ix @e - it "UnsafeLinearGrow" $ property $ prop_UnsafeLinearGrow @r @ix @e + prop "UnsafeNewMsize" $ prop_UnsafeNewMsize @r @ix @e + prop "UnsafeNewLinearWriteRead" $ prop_UnsafeNewLinearWriteRead @r @ix @e + prop "UnsafeThawFreeze" $ prop_UnsafeThawFreeze @r @ix @e + prop "UnsafeInitializeNew" $ prop_UnsafeInitializeNew @r @ix @e + prop "UnsafeLinearSet" $ prop_UnsafeLinearSet @r @ix @e + prop "UnsafeLinearCopy" $ prop_UnsafeLinearCopy @r @ix @e + prop "UnsafeLinearCopyPart" $ prop_UnsafeLinearCopyPart @r @ix @e + prop "UnsafeArrayLinearCopy" $ prop_UnsafeArrayLinearCopy @r @ix @e + prop "UnsafeArrayLinearCopyPart" $ prop_UnsafeArrayLinearCopyPart @r @ix @e + prop "UnsafeLinearShrink" $ prop_UnsafeLinearShrink @r @ix @e + prop "UnsafeLinearGrow" $ prop_UnsafeLinearGrow @r @ix @e + prop "UnsafeLinearSliceMArray" $ prop_UnsafeLinearSliceMArray @r @ix @e unsafeMutableUnboxedSpec :: forall r ix e. diff --git a/massiv-test/tests/Test/Massiv/Array/Delayed/StreamSpec.hs b/massiv-test/tests/Test/Massiv/Array/Delayed/StreamSpec.hs index 00a4e467..7bfc61bd 100644 --- a/massiv-test/tests/Test/Massiv/Array/Delayed/StreamSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/Delayed/StreamSpec.hs @@ -1,8 +1,14 @@ +{-# LANGUAGE TypeApplications #-} + module Test.Massiv.Array.Delayed.StreamSpec (spec) where +import Data.Massiv.Array import Test.Massiv.Core import Test.Massiv.Array.Delayed - +import Test.Massiv.Array.Load +import Data.Int spec :: Spec -spec = delayedStreamSpec +spec = do + delayedStreamSpec + loadSpec @DS @Ix1 @Int16 diff --git a/massiv-test/tests/Test/Massiv/Array/MutableSpec.hs b/massiv-test/tests/Test/Massiv/Array/MutableSpec.hs index 63ff31ea..af29f776 100644 --- a/massiv-test/tests/Test/Massiv/Array/MutableSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/MutableSpec.hs @@ -13,7 +13,9 @@ import Test.Massiv.Core import Test.Massiv.Core.Mutable import Test.Massiv.Array.Delayed import Test.Massiv.Array.Mutable +import Test.Massiv.Array.Load import GHC.Exts +import Data.Int type MutableArraySpec r ix e = ( Show e @@ -63,6 +65,11 @@ specMutableR = do mutableSpec @r @Ix2 @e mutableSpec @r @Ix3 @e mutableSpec @r @Ix4 @e + 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 @@ -75,7 +82,6 @@ specMutableR = do specMutableNonFlatR @r @Ix5 @e describe "toStream/toList" $ it "toStreamIsList" $ property (prop_toStreamIsList @r @e) - --mutableSpec @r @Ix5 @e -- slows down the test suite specMutableNonFlatR :: forall r ix e. @@ -92,7 +98,7 @@ specMutableNonFlatR :: => 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 @@ -245,12 +251,12 @@ prop_outerSliceMArrayM (ArrNE arr) = spec :: Spec spec = do - specMutableR @B @Int - specMutableR @N @Int - specMutableR @BL @Int - specUnboxedMutableR @S @Int - specUnboxedMutableR @P @Int - specUnboxedMutableR @U @Int + specMutableR @B @Int16 + specMutableR @N @Int16 + specMutableR @BL @Int16 + specUnboxedMutableR @S @Int16 + specUnboxedMutableR @P @Int16 + specUnboxedMutableR @U @Int16 atomicIntSpec @Ix1 atomicIntSpec @Ix2 atomicIntSpec @Ix3 diff --git a/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs b/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs index c8faaf87..73e27292 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs @@ -80,16 +80,6 @@ import System.IO.Unsafe (unsafePerformIO) #include "massiv.h" -sizeofArray :: A.Array e -> Int -sizeofMutableArray :: A.MutableArray s e -> Int -#if MIN_VERSION_primitive(0,6,2) -sizeofArray = A.sizeofArray -sizeofMutableArray = A.sizeofMutableArray -#else -sizeofArray (A.Array a#) = I# (sizeofArray# a#) -sizeofMutableArray (A.MutableArray ma#) = I# (sizeofMutableArray# ma#) -#endif - ---------------- -- Boxed Lazy -- ---------------- @@ -139,7 +129,7 @@ instance Strategy BL where instance Source BL e where unsafeLinearIndex (BLArray _ _sz o a) i = INDEX_CHECK("(Source BL ix e).unsafeLinearIndex", - SafeSz . sizeofArray, A.indexArray) a (i + o) + SafeSz . A.sizeofArray, A.indexArray) a (i + o) {-# INLINE unsafeLinearIndex #-} unsafeOuterSlice (BLArray c _ o a) szL i = BLArray c szL (i * totalElem szL + o) a @@ -158,7 +148,7 @@ instance Manifest BL e where unsafeLinearIndexM (BLArray _ _sz o a) i = INDEX_CHECK("(Manifest BL ix e).unsafeLinearIndexM", - SafeSz . sizeofArray, A.indexArray) a (i + o) + SafeSz . A.sizeofArray, A.indexArray) a (i + o) {-# INLINE unsafeLinearIndexM #-} @@ -191,12 +181,12 @@ instance Mutable BL e where unsafeLinearRead (MBLArray _ o ma) i = INDEX_CHECK("(Mutable BL ix e).unsafeLinearRead", - SafeSz . sizeofMutableArray, A.readArray) ma (i + o) + SafeSz . A.sizeofMutableArray, A.readArray) ma (i + o) {-# INLINE unsafeLinearRead #-} unsafeLinearWrite (MBLArray _sz o ma) i e = e `seq` INDEX_CHECK("(Mutable BL ix e).unsafeLinearWrite", - SafeSz . sizeofMutableArray, A.writeArray) ma (i + o) e + SafeSz . A.sizeofMutableArray, A.writeArray) ma (i + o) e {-# INLINE unsafeLinearWrite #-} instance Size BL where @@ -630,7 +620,7 @@ unwrapLazyArray = blData -- -- @since 0.6.0 wrapLazyArray :: A.Array e -> Vector BL e -wrapLazyArray a = BLArray Seq (SafeSz (sizeofArray a)) 0 a +wrapLazyArray a = BLArray Seq (SafeSz (A.sizeofArray a)) 0 a {-# INLINE wrapLazyArray #-} @@ -737,7 +727,7 @@ fromMutableArraySeq :: -> A.MutableArray (PrimState m) e -> m (MArray (PrimState m) BL Ix1 e) fromMutableArraySeq with ma = do - let !sz = sizeofMutableArray ma + let !sz = A.sizeofMutableArray ma loopM_ 0 (< sz) (+ 1) (A.readArray ma >=> (`with` return ())) return $! MBLArray (SafeSz sz) 0 ma {-# INLINE fromMutableArraySeq #-} diff --git a/massiv/src/Data/Massiv/Array/Manifest/Internal.hs b/massiv/src/Data/Massiv/Array/Manifest/Internal.hs index bf0d8cac..6357e399 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Internal.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Internal.hs @@ -1,5 +1,4 @@ {-# LANGUAGE BangPatterns #-} -{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MagicHash #-} @@ -36,8 +35,6 @@ module Data.Massiv.Array.Manifest.Internal , gcastArr , fromRaggedArrayM , fromRaggedArray' - , sizeofArray - , sizeofMutableArray , iterateUntil , iterateUntilM ) where @@ -54,21 +51,6 @@ import Data.Maybe (fromMaybe) import Data.Typeable import System.IO.Unsafe (unsafePerformIO) -#if MIN_VERSION_primitive(0,6,2) -import Data.Primitive.Array (sizeofArray, sizeofMutableArray) - -#else -import qualified Data.Primitive.Array as A (Array(..), MutableArray(..)) -import GHC.Exts (sizeofArray#, sizeofMutableArray#) - -sizeofArray :: A.Array a -> Int -sizeofArray (A.Array a) = I# (sizeofArray# a) -{-# INLINE sizeofArray #-} - -sizeofMutableArray :: A.MutableArray s a -> Int -sizeofMutableArray (A.MutableArray ma) = I# (sizeofMutableArray# ma) -{-# INLINE sizeofMutableArray #-} -#endif -- | Ensure that Array is computed, i.e. represented with concrete elements in memory, hence is the -- `Mutable` type class restriction. Use `setComp` if you'd like to change computation strategy diff --git a/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs b/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs index 9a84d427..ae0bbf29 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs @@ -202,7 +202,7 @@ instance Prim e => Mutable P e where {-# INLINE unsafeLinearShrink #-} unsafeLinearGrow (MPArray _ o ma) sz = - MPArray sz o <$> resizeMutableByteArrayCompat ma ((o + totalElem sz) * sizeOf (undefined :: e)) + MPArray sz o <$> resizeMutableByteArray ma ((o + totalElem sz) * sizeOf (undefined :: e)) {-# INLINE unsafeLinearGrow #-} @@ -607,27 +607,3 @@ unsafeAtomicXorIntArray _mpa@(MPArray sz o mba) ix (I# e#) = mba (o + toLinearIndex sz ix) {-# INLINE unsafeAtomicXorIntArray #-} - - -#if !MIN_VERSION_primitive(0,7,1) -shrinkMutableByteArray :: forall m. (PrimMonad m) - => MutableByteArray (PrimState m) - -> Int -- ^ new size - -> m () -shrinkMutableByteArray (MutableByteArray arr#) (I# n#) - = primitive_ (shrinkMutableByteArray# arr# n#) -{-# INLINE shrinkMutableByteArray #-} -#endif - -resizeMutableByteArrayCompat :: - PrimMonad m => MutableByteArray (PrimState m) -> Int -> m (MutableByteArray (PrimState m)) -#if MIN_VERSION_primitive(0,6,4) -resizeMutableByteArrayCompat = resizeMutableByteArray -#else -resizeMutableByteArrayCompat (MutableByteArray arr#) (I# n#) = - primitive - (\s# -> - case resizeMutableByteArray# arr# n# s# of - (# s'#, arr'# #) -> (# s'#, MutableByteArray arr'# #)) -#endif -{-# INLINE resizeMutableByteArrayCompat #-} diff --git a/stack-extra-deps.yaml b/stack-extra-deps.yaml index 7c4bb031..aa63674f 100644 --- a/stack-extra-deps.yaml +++ b/stack-extra-deps.yaml @@ -1,4 +1,4 @@ -resolver: lts-16.31 +resolver: lts-14.27 packages: - 'massiv/' - 'massiv-test/' From 457e70fbf204374a9f196043ded0ef17fbf93ab5 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sun, 25 Jul 2021 19:01:48 +0300 Subject: [PATCH 45/65] Fix examples CI --- .github/workflows/haskell.yml | 2 +- massiv-examples/GameOfLife/stack.yaml | 7 ++-- massiv-examples/examples/stack.yaml | 10 +++++- massiv-examples/vision/stack.yaml | 12 +++++-- massiv/CHANGELOG.md | 1 + massiv/src/Data/Massiv/Core/Index/Internal.hs | 19 +++++++++++ massiv/src/Data/Massiv/Core/Index/Ix.hs | 33 +++++++++++++++++++ massiv/src/Data/Massiv/Core/Index/Stride.hs | 12 +++++++ 8 files changed, 89 insertions(+), 7 deletions(-) diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index bad44243..826bdf25 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -120,7 +120,7 @@ jobs: runs-on: ubuntu-latest env: - STACK_ARGS: '--resolver lts-16.31' + STACK_ARGS: '--resolver lts-18.3' steps: - uses: actions/checkout@v2 diff --git a/massiv-examples/GameOfLife/stack.yaml b/massiv-examples/GameOfLife/stack.yaml index af178d27..ba4cd36b 100644 --- a/massiv-examples/GameOfLife/stack.yaml +++ b/massiv-examples/GameOfLife/stack.yaml @@ -1,8 +1,11 @@ -resolver: lts-16.3 - +resolver: lts-18.3 packages: - . extra-deps: - ../../massiv +- github: lehins/haskell-scheduler + commit: c5506d20d96fc3fb00c213791243b7246d39e822 + subdirs: + - scheduler nix: packages: [ zlib libGLU ] diff --git a/massiv-examples/examples/stack.yaml b/massiv-examples/examples/stack.yaml index 0bf1da9d..6b534e56 100644 --- a/massiv-examples/examples/stack.yaml +++ b/massiv-examples/examples/stack.yaml @@ -1,5 +1,13 @@ -resolver: lts-17.8 +resolver: lts-18.3 packages: - '.' extra-deps: - '../../massiv/' +- github: lehins/massiv-io + commit: 45ab3265b50f792daafefa8d9b686483fb058538 + subdirs: + - massiv-io +- github: lehins/haskell-scheduler + commit: c5506d20d96fc3fb00c213791243b7246d39e822 + subdirs: + - scheduler diff --git a/massiv-examples/vision/stack.yaml b/massiv-examples/vision/stack.yaml index 4d2c4521..32edaa9f 100644 --- a/massiv-examples/vision/stack.yaml +++ b/massiv-examples/vision/stack.yaml @@ -1,7 +1,13 @@ -resolver: lts-16.3 +resolver: lts-18.3 packages: - . - ../../massiv extra-deps: -- Color-0.2.0@sha256:94c43c4d8f943ba0642ee58a9b8a665b01a3ac2893c40a16ffdabaacb956c58f,8159 -- massiv-io-0.3.0.1@sha256:393df632ea8c3b0549a2b3a2fbaa6a9ef1202a05dd9b3f44555a9f6a31327652,3667 +- github: lehins/massiv-io + commit: 45ab3265b50f792daafefa8d9b686483fb058538 + subdirs: + - massiv-io +- github: lehins/haskell-scheduler + commit: c5506d20d96fc3fb00c213791243b7246d39e822 + subdirs: + - scheduler diff --git a/massiv/CHANGELOG.md b/massiv/CHANGELOG.md index 1067a001..87e93781 100644 --- a/massiv/CHANGELOG.md +++ b/massiv/CHANGELOG.md @@ -42,6 +42,7 @@ `Source`. Functions affected: * `mapIO_`, `imapIO_`, `forIO_` and `iforIO_` * `mapIO`, `imapIO`, `forIO` and `iforIO` +* Add `Uniform`, `UniformRange` and `Random` instances for `Ix2`, `IxN`, `Dim`, `Sz` and `Stride` # 0.6.1 diff --git a/massiv/src/Data/Massiv/Core/Index/Internal.hs b/massiv/src/Data/Massiv/Core/Index/Internal.hs index eb76efbf..3588929b 100644 --- a/massiv/src/Data/Massiv/Core/Index/Internal.hs +++ b/massiv/src/Data/Massiv/Core/Index/Internal.hs @@ -69,6 +69,7 @@ import Data.Kind import Data.Massiv.Core.Iterator import Data.Typeable import GHC.TypeLits +import System.Random.Stateful -- | `Sz` is the size of the array. It describes total number of elements along -- each dimension in the array. It is a wrapper around an index of the same @@ -127,6 +128,16 @@ pattern Sz1 ix <- SafeSz ix where {-# COMPLETE Sz1 #-} +instance (UniformRange ix, Index ix) => Uniform (Sz ix) where + uniformM g = SafeSz <$> uniformRM (pureIndex 0, pureIndex maxBound) g + {-# INLINE uniformM #-} + +instance UniformRange ix => UniformRange (Sz ix) where + uniformRM (SafeSz l, SafeSz u) g = SafeSz <$> uniformRM (l, u) g + {-# INLINE uniformRM #-} + +instance (UniformRange ix, Index ix) => Random (Sz ix) + instance Index ix => Show (Sz ix) where showsPrec n sz@(SafeSz usz) = showsPrecWrapped n (str ++) where @@ -343,6 +354,14 @@ newtype Dim = Dim { unDim :: Int } deriving (Eq, Ord, Num, Real, Integral, Enum, instance Show Dim where show (Dim d) = "(Dim " ++ show d ++ ")" +instance Uniform Dim where + uniformM g = Dim <$> uniformRM (1, maxBound) g + +instance UniformRange Dim where + uniformRM r g = Dim <$> uniformRM (coerce r) g + +instance Random Dim + -- | A way to select Array dimension at a type level. -- -- @since 0.2.4 diff --git a/massiv/src/Data/Massiv/Core/Index/Ix.hs b/massiv/src/Data/Massiv/Core/Index/Ix.hs index 531f639e..c1b9d0e6 100644 --- a/massiv/src/Data/Massiv/Core/Index/Ix.hs +++ b/massiv/src/Data/Massiv/Core/Index/Ix.hs @@ -48,6 +48,7 @@ import qualified Data.Vector.Generic as V import qualified Data.Vector.Generic.Mutable as VM import qualified Data.Vector.Unboxed as VU import GHC.TypeLits +import System.Random.Stateful #if !MIN_VERSION_base(4,11,0) import Data.Semigroup #endif @@ -158,6 +159,38 @@ instance Show Ix2 where instance Show (Ix (n - 1)) => Show (IxN n) where showsPrec n (i :> ix) = showsPrecWrapped n (shows i . (" :> " ++) . shows ix) +instance Uniform Ix2 where + uniformM g = (:.) <$> uniformM g <*> uniformM g + {-# INLINE uniformM #-} + +instance UniformRange Ix2 where + uniformRM (l1 :. l2, u1 :. u2) g = (:.) <$> uniformRM (l1, u1) g <*> uniformRM (l2, u2) g + {-# INLINE uniformRM #-} + +instance Random Ix2 + +instance Uniform (Ix (n - 1)) => Uniform (IxN n) where + uniformM g = (:>) <$> uniformM g <*> uniformM g + {-# INLINE uniformM #-} + +instance UniformRange (Ix (n - 1)) => UniformRange (IxN n) where + uniformRM (l1 :> l2, u1 :> u2) g = (:>) <$> uniformRM (l1, u1) g <*> uniformRM (l2, u2) g + {-# INLINE uniformRM #-} + +instance Random (Ix (n - 1)) => Random (IxN n) where + random g = + case random g of + (i, g') -> + case random g' of + (n, g'') -> (i :> n, g'') + {-# INLINE random #-} + randomR (l1 :> l2, u1 :> u2) g = + case randomR (l1, u1) g of + (i, g') -> + case randomR (l2, u2) g' of + (n, g'') -> (i :> n, g'') + {-# INLINE randomR #-} + instance Num Ix2 where (+) = liftIndex2 (+) diff --git a/massiv/src/Data/Massiv/Core/Index/Stride.hs b/massiv/src/Data/Massiv/Core/Index/Stride.hs index 92228e47..8a1daf57 100644 --- a/massiv/src/Data/Massiv/Core/Index/Stride.hs +++ b/massiv/src/Data/Massiv/Core/Index/Stride.hs @@ -21,6 +21,7 @@ module Data.Massiv.Core.Index.Stride import Control.DeepSeq import Data.Massiv.Core.Index.Internal +import System.Random.Stateful -- | Stride provides a way to ignore elements of an array if an index is divisible by a -- corresponding value in a stride. So, for a @Stride (i :. j)@ only elements with indices will be @@ -65,6 +66,17 @@ instance Index ix => Show (Stride ix) where showsPrec n (SafeStride ix) = showsPrecWrapped n (("Stride " ++) . showsPrec 1 ix) +instance (UniformRange ix, Index ix) => Uniform (Stride ix) where + uniformM g = SafeStride <$> uniformRM (pureIndex 1, pureIndex maxBound) g + {-# INLINE uniformM #-} + +instance UniformRange ix => UniformRange (Stride ix) where + uniformRM (SafeStride l, SafeStride u) g = SafeStride <$> uniformRM (l, u) g + {-# INLINE uniformRM #-} + +instance (UniformRange ix, Index ix) => Random (Stride ix) + + -- | Just a helper function for unwrapping `Stride`. -- -- @since 0.2.1 From 6e07ab6fff8dc0cb88ee7e4ecc873b631cafc68b Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sun, 25 Jul 2021 23:24:20 +0300 Subject: [PATCH 46/65] Add `Data.Ix.Ix` instance for `Ix2` and `IxN` --- Quickref.md | 4 +--- massiv/src/Data/Massiv/Core/Index/Ix.hs | 19 +++++++++++++++++++ 2 files changed, 20 insertions(+), 3 deletions(-) diff --git a/Quickref.md b/Quickref.md index cee44213..7567fd80 100644 --- a/Quickref.md +++ b/Quickref.md @@ -34,9 +34,7 @@ get mapped into an element in memory at some point. ### Class dependency ``` - Construct (D, DL, DS, DI, DW, B, N, P, U, S, LN) -> Ragged (L) - \ -Load (DL, DS, DI, DW, L, LN) -> Source (D) -> Manifest (M) -`-> Mutable (B, N, P, U, S) +Load (DL, DS, DI, DW, L, LN) -> Source (D) -> Manifest (M) -> Mutable (B, N, P, U, S) |\ | `> StrideLoad (D, DI, DW, M, B, N, P, U, S) |\ diff --git a/massiv/src/Data/Massiv/Core/Index/Ix.hs b/massiv/src/Data/Massiv/Core/Index/Ix.hs index c1b9d0e6..cd8d2fc9 100644 --- a/massiv/src/Data/Massiv/Core/Index/Ix.hs +++ b/massiv/src/Data/Massiv/Core/Index/Ix.hs @@ -44,6 +44,7 @@ import Control.Monad.Catch (MonadThrow(..)) import Control.DeepSeq import Data.Massiv.Core.Index.Internal import Data.Proxy +import qualified GHC.Arr as I import qualified Data.Vector.Generic as V import qualified Data.Vector.Generic.Mutable as VM import qualified Data.Vector.Unboxed as VU @@ -191,6 +192,24 @@ instance Random (Ix (n - 1)) => Random (IxN n) where (n, g'') -> (i :> n, g'') {-# INLINE randomR #-} +instance I.Ix Ix2 where + range (i1 :. j1, i2 :. j2) = [i :. j | i <- [i1 .. i2], j <- [j1 .. j2]] + {-# INLINE range #-} + unsafeIndex (l1 :. l2, u1 :. u2) (i1 :. i2) = + I.unsafeIndex (l1, u1) i1 * I.unsafeRangeSize (l2, u2) + I.unsafeIndex (l2, u2) i2 + {-# INLINE unsafeIndex #-} + inRange (l1 :. l2, u1 :. u2) (i1 :. i2) = I.inRange (l1, u1) i1 && I.inRange (l2, u2) i2 + {-# INLINE inRange #-} + +instance I.Ix (Ix (n - 1)) => I.Ix (IxN n) where + range (i1 :> j1, i2 :> j2) = [i :> j | i <- [i1 .. i2], j <- I.range (j1, j2)] + {-# INLINE range #-} + unsafeIndex (l1 :> l2, u1 :> u2) (i1 :> i2) = + I.unsafeIndex (l1, u1) i1 * I.unsafeRangeSize (l2, u2) + I.unsafeIndex (l2, u2) i2 + {-# INLINE unsafeIndex #-} + inRange (l1 :> l2, u1 :> u2) (i1 :> i2) = I.inRange (l1, u1) i1 && I.inRange (l2, u2) i2 + {-# INLINE inRange #-} + instance Num Ix2 where (+) = liftIndex2 (+) From 1332e891f82fcb5fd075c91d0e52d1612aa46476 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Mon, 26 Jul 2021 02:25:42 +0300 Subject: [PATCH 47/65] Consolidate `Mutable` into `Manifest` type class and move the `MArray` data family outside of the class. --- Quickref.md | 30 ++-- massiv-bench/bench/Concat.hs | 4 +- massiv-bench/src/Data/Massiv/Bench/Common.hs | 2 +- massiv-bench/src/Data/Massiv/Bench/Matrix.hs | 12 +- massiv-bench/src/Data/Massiv/Bench/Vector.hs | 6 +- .../examples/src/Examples/SortRows.hs | 2 +- massiv-test/src/Test/Massiv/Array/Mutable.hs | 28 ++-- massiv-test/src/Test/Massiv/Array/Numeric.hs | 28 ++-- massiv-test/src/Test/Massiv/Core/Mutable.hs | 34 ++--- .../Test/Massiv/Array/Manifest/VectorSpec.hs | 6 +- .../tests/Test/Massiv/Array/MutableSpec.hs | 16 +- .../Test/Massiv/Array/Numeric/IntegralSpec.hs | 2 +- .../Test/Massiv/Array/Ops/ConstructSpec.hs | 4 +- .../tests/Test/Massiv/Array/Ops/MapSpec.hs | 2 +- .../Test/Massiv/Array/Ops/TransformSpec.hs | 18 +-- .../tests/Test/Massiv/Array/StencilSpec.hs | 54 +++---- massiv-test/tests/Test/Massiv/ArraySpec.hs | 49 +++--- massiv-test/tests/Test/Massiv/VectorSpec.hs | 8 +- massiv/CHANGELOG.md | 2 + .../src/Data/Massiv/Array/Manifest/Boxed.hs | 26 ++-- .../Data/Massiv/Array/Manifest/Internal.hs | 38 ++--- massiv/src/Data/Massiv/Array/Manifest/List.hs | 6 +- .../Data/Massiv/Array/Manifest/Primitive.hs | 12 +- .../Data/Massiv/Array/Manifest/Storable.hs | 11 +- .../src/Data/Massiv/Array/Manifest/Unboxed.hs | 12 +- .../src/Data/Massiv/Array/Manifest/Vector.hs | 13 +- massiv/src/Data/Massiv/Array/Mutable.hs | 144 +++++++++--------- .../Data/Massiv/Array/Mutable/Algorithms.hs | 2 +- .../src/Data/Massiv/Array/Mutable/Internal.hs | 6 +- massiv/src/Data/Massiv/Array/Numeric.hs | 15 +- .../src/Data/Massiv/Array/Numeric/Integral.hs | 10 +- massiv/src/Data/Massiv/Array/Ops/Construct.hs | 12 +- massiv/src/Data/Massiv/Array/Ops/Map.hs | 46 +++--- massiv/src/Data/Massiv/Array/Ops/Sort.hs | 18 +-- massiv/src/Data/Massiv/Array/Ops/Transform.hs | 6 +- massiv/src/Data/Massiv/Array/Unsafe.hs | 4 +- massiv/src/Data/Massiv/Core/Common.hs | 57 ++++--- massiv/src/Data/Massiv/Vector.hs | 11 +- massiv/src/Data/Massiv/Vector/Stream.hs | 22 +-- 39 files changed, 389 insertions(+), 389 deletions(-) diff --git a/Quickref.md b/Quickref.md index 7567fd80..6f793850 100644 --- a/Quickref.md +++ b/Quickref.md @@ -16,17 +16,16 @@ order of things. Below are two ways to index an array in massiv: λ> arr !> 1 !> 2 (Array M Seq (Sz1 (4)) [ 2,3,5,9 ]) -λ> arr !> 1 !> 2 !> 3 +λ> arr !> 1 !> 2 ! 3 9 ``` Former does the lookup of an element in the array, while the latter slices the array until it gets to -the actual element. Normally they are equivalent, but since implemnetation i svastly different, -difference in performance could be expected. +the actual element. -Most important thing to agree upon is the fact that at the end of the day we do represent data in a -linear row-major fashion, so the above indexing technique translates into a linear index that will -get mapped into an element in memory at some point. +Data is represented in a linear row-major fashion, so the above indexing +technique translates into a linear index that will get mapped into an element in +memory at some point. ## Hierarchy @@ -34,21 +33,22 @@ get mapped into an element in memory at some point. ### Class dependency ``` -Load (DL, DS, DI, DW, L, LN) -> Source (D) -> Manifest (M) -> Mutable (B, N, P, U, S) +Size (DL, D, DI, DW, B, BN, BL, P, U, S) -> Resize -> +Load (DL, DS, DI, DW, L, LN) -> Source (D) -> Mutable (B, BN, BL, P, U, S) |\ - | `> StrideLoad (D, DI, DW, M, B, N, P, U, S) + | `> StrideLoad (D, DI, DW, B, BN, BL, P, U, S) |\ - | `> Extract (D, DS, DI, M, B, N, P, U, S) + | `> Extract (D, DS, DI, B, BN, BL, P, U, S) |\ - | `> Slice (D, M, B, N, P, U, S) + | `> Slice (D, B, BN, BL, P, U, S) |\ - | `> OuterSlice (D, M, B, N, P, U, S, L) + | `> OuterSlice (D, B, BN, BL, P, U, S, L) \ - `> InnerSlice (D, M, B, N, P, U, S) + `> InnerSlice (D, B, BN, BL, P, U, S) -Stream (D, DS, B, N, P, U, S, L, LN) +Stream (D, DS, B, BN, BL, P, U, S, L, LN) -Resize (D, DL, DI, B, N, P, U, S) +Resize (D, DL, DI, B, BN, BL, P, U, S) ``` ## Computation @@ -60,7 +60,7 @@ to that: construction or conversion, eg. from a list or vector * array computation strategy will be combined according to its `Monoid` instance when two or more arrays are being joined together by some operation into another one. -* Most of functions will respect the inner computation strategy, while other will ignore it due to +* Most of functions will respect the inner computation strategy, while others will ignore it due to their specific nature. ## Naming Conventions diff --git a/massiv-bench/bench/Concat.hs b/massiv-bench/bench/Concat.hs index 40a32f56..eefbae77 100644 --- a/massiv-bench/bench/Concat.hs +++ b/massiv-bench/bench/Concat.hs @@ -40,7 +40,7 @@ main = do ] concatMutableM :: - forall r' r ix e . (Size r', Load r' ix e, Load r ix e, Mutable r e) + forall r' r ix e . (Size r', Load r' ix e, Load r ix e, Manifest r e) => [Array r' ix e] -> IO (Array r ix e) concatMutableM arrsF = @@ -69,7 +69,7 @@ concatMutableM arrsF = {-# INLINE concatMutableM #-} concatNewM :: - forall ix e r. (Index ix, Mutable r e, Load r ix e) + forall ix e r. (Index ix, Manifest r e, Load r ix e) => [Array r ix e] -> IO (Array r ix e) concatNewM arrsF = diff --git a/massiv-bench/src/Data/Massiv/Bench/Common.hs b/massiv-bench/src/Data/Massiv/Bench/Common.hs index 6c483e7a..5321fc87 100644 --- a/massiv-bench/src/Data/Massiv/Bench/Common.hs +++ b/massiv-bench/src/Data/Massiv/Bench/Common.hs @@ -18,7 +18,7 @@ stdGen = mkStdGen 2020 showsType :: forall t . Typeable t => ShowS showsType = showsTypeRep (typeRep (Proxy :: Proxy t)) -makeRandomArray :: (Index ix, Mutable r e, Random e) => Sz ix -> IO (Array r ix e) +makeRandomArray :: (Index ix, Manifest r e, Random e) => Sz ix -> IO (Array r ix e) makeRandomArray sz = do gen <- newStdGen pure $! snd $ randomArrayS gen sz random diff --git a/massiv-bench/src/Data/Massiv/Bench/Matrix.hs b/massiv-bench/src/Data/Massiv/Bench/Matrix.hs index ddbe171e..79132db6 100644 --- a/massiv-bench/src/Data/Massiv/Bench/Matrix.hs +++ b/massiv-bench/src/Data/Massiv/Bench/Matrix.hs @@ -35,7 +35,7 @@ bMxMsize = Sz2 m n -> Sz2 n m -randomMxM :: (Mutable r e, Random e) => MxM r e +randomMxM :: (Manifest r e, Random e) => MxM r e randomMxM = case randomArrayS stdGen aMxMsize random of (g, a) -> MxM {aMxM = a, bMxM = snd $ randomArrayS g bMxMsize random} @@ -58,7 +58,7 @@ showSizeMxM MxM {..} = show m1 <> "x" <> show n1 <> " X " <> show m2 <> "x" <> s benchMxM :: - forall r e. (Typeable r, Typeable e, Load r Ix1 e, Load r Ix2 e, Numeric r e, Mutable r e) + forall r e. (Typeable r, Typeable e, Load r Ix1 e, Load r Ix2 e, Numeric r e, Manifest r e) => MxM r e -> Benchmark benchMxM mxm@MxM {..} = @@ -88,7 +88,7 @@ bMxVsize = case aMxVsize of Sz2 _ n -> Sz1 n -randomMxV :: (Mutable r e, Random e) => MxV r e +randomMxV :: (Manifest r e, Random e) => MxV r e randomMxV = case randomArrayS stdGen aMxVsize random of (g, a) -> MxV {aMxV = a, bMxV = snd $ randomArrayS g bMxVsize random} @@ -101,7 +101,7 @@ showSizeMxV MxV {..} = show m1 <> "x" <> show n1 <> " X " <> show n <> "x1" benchMxV :: - forall r e. (Typeable r, Typeable e, Numeric r e, Mutable r e, Load r Ix2 e) + forall r e. (Typeable r, Typeable e, Numeric r e, Manifest r e, Load r Ix2 e) => MxV r e -> Benchmark benchMxV mxv@MxV {..} = @@ -146,13 +146,13 @@ showSizeVxM VxM {..} = "1x" <> show n <> " X " <> show m2 <> "x" <> show n2 Sz2 m2 n2 = size bVxM -randomVxM :: (Mutable r e, Random e) => VxM r e +randomVxM :: (Manifest r e, Random e) => VxM r e randomVxM = case randomArrayS stdGen aVxMsize random of (g, a) -> VxM {aVxM = a, bVxM = snd $ randomArrayS g bVxMsize random} benchVxM :: - forall r e. (Typeable r, Typeable e, Load r Ix1 e, Load r Ix2 e, Numeric r e, Mutable r e) + forall r e. (Typeable r, Typeable e, Load r Ix1 e, Load r Ix2 e, Numeric r e, Manifest r e) => VxM r e -> Benchmark benchVxM mxv@VxM {..} = diff --git a/massiv-bench/src/Data/Massiv/Bench/Vector.hs b/massiv-bench/src/Data/Massiv/Bench/Vector.hs index 7733283f..318310f1 100644 --- a/massiv-bench/src/Data/Massiv/Bench/Vector.hs +++ b/massiv-bench/src/Data/Massiv/Bench/Vector.hs @@ -24,7 +24,7 @@ v1size :: Sz1 v1size = Sz1 1000000 -randomV1 :: (Mutable r e, Random e) => Vector r e +randomV1 :: (Manifest r e, Random e) => Vector r e randomV1 = snd $ randomArrayS stdGen v1size random @@ -63,7 +63,7 @@ bVxVsize :: Sz1 bVxVsize = aVxVsize -randomVxV :: (Mutable r e, Random e) => VxV r e +randomVxV :: (Manifest r e, Random e) => VxV r e randomVxV = case randomArrayS stdGen aVxVsize random of (g, a) -> VxV {aVxV = a, bVxV = snd $ randomArrayS g bVxVsize random} @@ -76,7 +76,7 @@ showSizeVxV VxV {..} = show n1 <> " X " <> show n2 benchVxV :: - forall r e. (Typeable r, Typeable e, Numeric r e, Mutable r e) + forall r e. (Typeable r, Typeable e, Numeric r e, Manifest r e) => VxV r e -> Benchmark benchVxV vxv@VxV {..} = diff --git a/massiv-examples/examples/src/Examples/SortRows.hs b/massiv-examples/examples/src/Examples/SortRows.hs index ce546344..bb0fba7b 100644 --- a/massiv-examples/examples/src/Examples/SortRows.hs +++ b/massiv-examples/examples/src/Examples/SortRows.hs @@ -17,7 +17,7 @@ sortRows :: ( Ord e , Typeable v , A.Load r Ix2 e - , A.Mutable r e + , A.Manifest r e , VG.Vector v e , ARepr v ~ r , VRepr r ~ v diff --git a/massiv-test/src/Test/Massiv/Array/Mutable.hs b/massiv-test/src/Test/Massiv/Array/Mutable.hs index cc66bf7b..fd9c2ca9 100644 --- a/massiv-test/src/Test/Massiv/Array/Mutable.hs +++ b/massiv-test/src/Test/Massiv/Array/Mutable.hs @@ -13,7 +13,7 @@ module Test.Massiv.Array.Mutable , prop_GrowShrink , prop_unfoldrList , prop_unfoldrReverseUnfoldl - , prop_toStreamArrayMutable + , prop_toStreamArrayManifest -- * Atomic ops spec , atomicIntSpec ) where @@ -31,13 +31,13 @@ import Test.Massiv.Utils as T import UnliftIO.Async --- prop_MapMapM :: forall r ix(Show (Array r ix Word), Eq (Array r ix Word), Mutable r ix) => +-- 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), Mutable r e, Index ix) + 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 @@ -49,7 +49,7 @@ prop_GenerateArray :: forall r ix e. ( Show (Array r ix e) , Eq (Array r ix e) - , Mutable r e + , Manifest r e , Load r ix e , Show e , Arbitrary e @@ -69,7 +69,7 @@ prop_GenerateArray = prop_Shrink :: forall r ix e. - (Show (Array r ix e), Mutable r e, Load r ix e, Arbitrary ix, Arbitrary e, Eq 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 @@ -83,7 +83,7 @@ prop_GrowShrink :: ( Eq (Array r ix e) , Show (Array r ix e) , Load r ix e - , Mutable r e + , Manifest r e , Arbitrary ix , Arbitrary e , Show e @@ -113,7 +113,7 @@ prop_unfoldrList :: , Arbitrary ix , Arbitrary e , Show e - , Mutable r e + , Manifest r e ) => Property prop_unfoldrList = @@ -131,7 +131,7 @@ prop_unfoldrReverseUnfoldl :: , Arbitrary ix , Arbitrary e , Show e - , Mutable r e + , Manifest r e ) => Property prop_unfoldrReverseUnfoldl = @@ -143,15 +143,15 @@ prop_unfoldrReverseUnfoldl = a2 <- unfoldlPrimM_ @r sz (pure . swapTuple . apply f) i rev a1 `shouldBe` a2 -prop_toStreamArrayMutable :: - forall r ix e. (Mutable 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_toStreamArrayMutable arr = +prop_toStreamArrayManifest arr = arr === S.unstreamExact (size arr) (S.stepsStream (toSteps (toStreamArray arr))) prop_WithMArray :: - forall r ix e. (HasCallStack, Index ix, Mutable r e, Eq (Array r ix e), Show (Array r ix e)) + 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 @@ -188,7 +188,7 @@ mutableSpec :: , Typeable e , Show e , Eq e - , Mutable r e + , Manifest r e , CoArbitrary ix , Arbitrary e , CoArbitrary e @@ -208,7 +208,7 @@ mutableSpec = do it "unfoldrList" $ prop_unfoldrList @r @ix @e it "unfoldrReverseUnfoldl" $ prop_unfoldrReverseUnfoldl @r @ix @e describe "Stream" $ - prop "toStreamArrayMutable" $ prop_toStreamArrayMutable @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. diff --git a/massiv-test/src/Test/Massiv/Array/Numeric.hs b/massiv-test/src/Test/Massiv/Array/Numeric.hs index bd686e41..0a0dad7f 100644 --- a/massiv-test/src/Test/Massiv/Array/Numeric.hs +++ b/massiv-test/src/Test/Massiv/Array/Numeric.hs @@ -6,7 +6,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} module Test.Massiv.Array.Numeric - ( -- * Spec for safe Mutable instance + ( -- * Spec for safe Manifest instance prop_MatrixMatrixMultiply , mutableNumericSpec , mutableNumericFloatSpec @@ -38,7 +38,7 @@ naiveMatrixMatrixMultiply arr1 arr2 prop_MatrixMatrixMultiply :: - forall r e. (Numeric r e, Mutable r e, Eq (Matrix r e), Show (Matrix r e)) + forall r e. (Numeric r e, Manifest r e, Eq (Matrix r e), Show (Matrix r e)) => Fun e e -> Matrix r e -> Property @@ -54,7 +54,7 @@ prop_MatrixMatrixMultiply f arr = expectProp $ do prop_MatrixVectorMultiply :: forall r e. ( Numeric r e - , Mutable r e + , Manifest r e , Load r Ix1 e , Eq e , Show e @@ -75,7 +75,7 @@ prop_VectorMatrixMultiply :: ( Numeric r e , Load r Ix1 e , Source r e - , Mutable r e + , Manifest r e , Show (Vector r e) , Eq (Vector r e) ) @@ -93,7 +93,7 @@ prop_VectorMatrixMultiply f arr = (== SizeMismatchException (Sz2 1 (m + 1)) (size arr)) prop_DotProduct :: - forall r e. (Numeric r e, Mutable r e, Eq e, Show e, Load r Ix1 e) + forall r e. (Numeric r e, Manifest r e, Eq e, Show e, Load r Ix1 e) => Fun e e -> Vector r e -> Property @@ -105,7 +105,7 @@ prop_DotProduct f v = (== SizeMismatchException (size v) (size v + 1)) prop_Norm :: - forall r e. (NumericFloat r e, Mutable r e, RealFloat e, Show e) + forall r e. (NumericFloat r e, Manifest r e, RealFloat e, Show e) => e -> Vector r e -> Property @@ -115,7 +115,7 @@ prop_Norm eps v = epsilonEq eps (sqrt (v !.! v)) (normL2 v) prop_Plus :: forall r e. - (Numeric r e, Mutable r e, Show (Matrix r e), Eq (Matrix r e)) + (Numeric r e, Manifest r e, Show (Matrix r e), Eq (Matrix r e)) => Fun e e -> Matrix r e -> e @@ -131,7 +131,7 @@ prop_Plus f arr e = expectProp $ do prop_Minus :: forall r e. - (Numeric r e, Mutable r e, Show (Array r Ix2 e), Eq (Array r Ix2 e)) + (Numeric r e, Manifest r e, Show (Array r Ix2 e), Eq (Array r Ix2 e)) => Fun e e -> Matrix r e -> e @@ -147,7 +147,7 @@ prop_Minus f arr e = expectProp $ do prop_Times :: forall r e. - (Numeric r e, Mutable r e, Show (Matrix r e), Eq (Matrix r e)) + (Numeric r e, Manifest r e, Show (Matrix r e), Eq (Matrix r e)) => Fun e e -> Matrix r e -> e @@ -164,7 +164,7 @@ prop_Times f arr e = expectProp $ do prop_Divide :: forall r e. ( NumericFloat r e - , Mutable r e + , Manifest r e , Show e , RealFloat e , Show (Matrix r e) @@ -211,7 +211,7 @@ prop_Floating eps arr = expectProp $ do epsilonFoldableExpect eps (delay (atanhA arr)) (A.map atanh arr) prop_Floating2 :: - forall r e. (RealFloat e, Mutable r e, NumericFloat r e, Show e) + forall r e. (RealFloat e, Manifest r e, NumericFloat r e, Show e) => e -> Matrix r e -> Fun e e @@ -227,7 +227,7 @@ prop_Floating2 eps arr1 f = expectProp $ do mutableNumericSpec :: forall r e. ( Numeric r e - , Mutable r e + , Manifest r e , Load r Ix1 e , Load r Ix2 e , Eq e @@ -267,14 +267,14 @@ mutableNumericSpec = mutableNumericFloatSpec :: forall r. ( NumericFloat r Float - , Mutable r Float + , Manifest r Float , Arbitrary (Vector r Float) , Arbitrary (Matrix r Float) , Show (Vector r Float) , Show (Matrix r Float) , Eq (Matrix r Float) , NumericFloat r Double - , Mutable r Double + , Manifest r Double , Arbitrary (Vector r Double) , Arbitrary (Matrix r Double) , Show (Vector r Double) diff --git a/massiv-test/src/Test/Massiv/Core/Mutable.hs b/massiv-test/src/Test/Massiv/Core/Mutable.hs index eb5fe43b..e11874b0 100644 --- a/massiv-test/src/Test/Massiv/Core/Mutable.hs +++ b/massiv-test/src/Test/Massiv/Core/Mutable.hs @@ -25,7 +25,7 @@ import Test.Massiv.Utils prop_UnsafeNewMsize :: forall r ix e. - (Arbitrary ix, Index ix, Mutable r e) + (Arbitrary ix, Index ix, Manifest r e) => Property prop_UnsafeNewMsize = property $ \ sz -> do marr :: MArray RealWorld r ix e <- unsafeNew sz @@ -33,7 +33,7 @@ prop_UnsafeNewMsize = property $ \ sz -> do prop_UnsafeNewLinearWriteRead :: forall r ix e. - (Eq e, Show e, Mutable r e, Index ix, Arbitrary ix, Arbitrary e) + (Eq e, Show e, Manifest r e, Index ix, Arbitrary ix, Arbitrary e) => Property prop_UnsafeNewLinearWriteRead = property $ \ (SzIx sz ix) e1 e2 -> do marr :: MArray RealWorld r ix e <- unsafeNew sz @@ -46,7 +46,7 @@ prop_UnsafeNewLinearWriteRead = property $ \ (SzIx sz ix) e1 e2 -> do prop_UnsafeThawFreeze :: forall r ix e. - (Eq (Array r ix e), Show (Array r ix e), Index ix, Mutable r 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) @@ -59,7 +59,7 @@ prop_UnsafeInitializeNew :: , Arbitrary e , Arbitrary ix , Index ix - , Mutable r e + , Manifest r e ) => Property prop_UnsafeInitializeNew = @@ -73,7 +73,7 @@ prop_UnsafeInitialize :: , Show (Array r ix e) , Arbitrary ix , Index ix - , Mutable r e + , Manifest r e ) => Property prop_UnsafeInitialize = @@ -86,7 +86,7 @@ prop_UnsafeInitialize = prop_UnsafeLinearCopy :: - forall r ix e. (Eq (Array r ix e), Show (Array r ix e), Index ix, Mutable r e) + 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 = @@ -106,7 +106,7 @@ prop_UnsafeLinearCopyPart :: , Show (Vector r e) , Eq (Array r ix e) , Show (Array r ix e) - , Mutable r e + , Manifest r e , Index ix ) => ArrIx r ix e @@ -130,7 +130,7 @@ prop_UnsafeLinearCopyPart (ArrIx arr ix) (NonNegative delta) toOffset = prop_UnsafeArrayLinearCopy :: - forall r ix e. (Eq (Array r ix e), Show (Array r ix e), Index ix, Mutable r e) + 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 = @@ -143,7 +143,7 @@ prop_UnsafeArrayLinearCopy arr = prop_UnsafeArrayLinearCopyPart :: - forall r ix e. (Eq (Vector r e), Show (Vector r e), Index ix, Mutable r e) + forall r ix e. (Eq (Vector r e), Show (Vector r e), Index ix, Manifest r e) => ArrIx r ix e -> NonNegative Ix1 -> Ix1 @@ -167,7 +167,7 @@ prop_UnsafeLinearSet :: ( Eq (Vector r e) , Show (Vector r e) , Index ix - , Mutable r e + , Manifest r e ) => Comp -> SzIx ix @@ -190,7 +190,7 @@ prop_UnsafeLinearShrink :: forall r ix e. ( Eq (Vector r e) , Show (Vector r e) - , Mutable r e + , Manifest r e , Index ix ) => ArrIx r ix e @@ -213,7 +213,7 @@ prop_UnsafeLinearGrow :: , Show (Array r ix e) , Eq (Vector r e) , Show (Vector r e) - , Mutable r e + , Manifest r e , Index ix ) => ArrIx r ix e @@ -239,7 +239,7 @@ prop_UnsafeLinearGrow (ArrIx arr ix) e = prop_UnsafeLinearSliceMArray :: - forall r ix e. (HasCallStack, Index ix, Mutable r e, Eq (Vector r e), Show (Vector r e)) + 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 = @@ -261,7 +261,7 @@ unsafeMutableSpec :: , Show (Vector r e) , Eq (Array r ix e) , Show (Array r ix e) - , Mutable r e + , Manifest r e , Show e , Eq e , Load r ix e @@ -271,7 +271,7 @@ unsafeMutableSpec :: ) => Spec unsafeMutableSpec = - describe ("Mutable (" ++ showsArrayType @r @ix @e ") (Unsafe)") $ do + describe ("Manifest (" ++ showsArrayType @r @ix @e ") (Unsafe)") $ do prop "UnsafeNewMsize" $ prop_UnsafeNewMsize @r @ix @e prop "UnsafeNewLinearWriteRead" $ prop_UnsafeNewLinearWriteRead @r @ix @e prop "UnsafeThawFreeze" $ prop_UnsafeThawFreeze @r @ix @e @@ -292,9 +292,9 @@ unsafeMutableUnboxedSpec :: , Show (Array r ix e) , Index ix , Arbitrary ix - , Mutable r e + , Manifest r e ) => Spec unsafeMutableUnboxedSpec = - describe ("Mutable Unboxed (" ++ showsArrayType @r @ix @e ") (Unsafe)") $ + describe ("Manifest Unboxed (" ++ showsArrayType @r @ix @e ") (Unsafe)") $ it "UnsafeInitialize" $ prop_UnsafeInitialize @r @ix @e diff --git a/massiv-test/tests/Test/Massiv/Array/Manifest/VectorSpec.hs b/massiv-test/tests/Test/Massiv/Array/Manifest/VectorSpec.hs index 802a98c8..c4488661 100644 --- a/massiv-test/tests/Test/Massiv/Array/Manifest/VectorSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/Manifest/VectorSpec.hs @@ -16,7 +16,7 @@ import qualified Data.Vector.Unboxed as VU prop_castToFromVector :: ( VG.Vector (VRepr r) Int - , Mutable r Int + , Manifest r Int , Typeable (VRepr r) , ARepr (VRepr r) ~ r , Eq (Array r ix Int) @@ -30,8 +30,8 @@ prop_castToFromVector _ _ (ArrNE arr) = prop_toFromVector :: forall r ix v. - ( Mutable r Int - , Mutable (ARepr v) Int + ( Manifest r Int + , Manifest (ARepr v) Int , VRepr (ARepr v) ~ v , Eq (Array r ix Int) , VG.Vector v Int diff --git a/massiv-test/tests/Test/Massiv/Array/MutableSpec.hs b/massiv-test/tests/Test/Massiv/Array/MutableSpec.hs index af29f776..124586d8 100644 --- a/massiv-test/tests/Test/Massiv/Array/MutableSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/MutableSpec.hs @@ -31,7 +31,7 @@ type MutableArraySpec r ix e , Load r ix e , Resize r , Arbitrary (Array r ix e) - , Mutable r e + , Manifest r e , Stream r ix e ) @@ -49,7 +49,7 @@ localMutableSpec :: forall r ix e. (MutableArraySpec r ix e) => Spec localMutableSpec = do describe "toStream/toList" $ it "toStream" $ property (prop_toStream @r @ix @e) - describe "Mutable operations" $ do + describe "Manifest operations" $ do it "write" $ property (prop_Write @r @ix @e) it "modify" $ property (prop_Modify @r @ix @e) it "swap" $ property (prop_Swap @r @ix @e) @@ -90,7 +90,7 @@ specMutableNonFlatR :: , Arbitrary e , Index (Lower ix) , Load r ix e - , Mutable r e + , Manifest r e , Eq (Array r (Lower ix) e) , Show (Array r (Lower ix) e) , Show (Array r ix e) @@ -111,7 +111,7 @@ specUnboxedMutableR = do unsafeMutableUnboxedSpec @r @Ix5 @e prop_Write :: - forall r ix e. (Index ix, Mutable r e, Eq e, Show e) + forall r ix e. (Index ix, Manifest r e, Eq e, Show e) => Array r ix e -> ix -> e @@ -144,7 +144,7 @@ prop_Write arr ix e = prop_Modify :: - forall r ix e. (Index ix, Mutable r e, Eq e, Show e) + forall r ix e. (Index ix, Manifest r e, Eq e, Show e) => Array r ix e -> Fun e e -> ix @@ -180,7 +180,7 @@ prop_Modify arr f ix = index' arr'' ix `shouldBe` fe prop_Swap :: - forall r ix e. (Index ix, Mutable r e, Eq e, Show e) + forall r ix e. (Index ix, Manifest r e, Eq e, Show e) => Array r ix e -> ix -> ix @@ -228,7 +228,7 @@ prop_outerSliceMArrayM :: forall r ix e. ( Index ix , Index (Lower ix) - , Mutable r e + , Manifest r e , Eq (Array r (Lower ix) e) , Show (Array r (Lower ix) e) ) @@ -252,7 +252,7 @@ prop_outerSliceMArrayM (ArrNE arr) = spec :: Spec spec = do specMutableR @B @Int16 - specMutableR @N @Int16 + specMutableR @BN @Int16 specMutableR @BL @Int16 specUnboxedMutableR @S @Int16 specUnboxedMutableR @P @Int16 diff --git a/massiv-test/tests/Test/Massiv/Array/Numeric/IntegralSpec.hs b/massiv-test/tests/Test/Massiv/Array/Numeric/IntegralSpec.hs index ca4b6e32..5b940a9e 100644 --- a/massiv-test/tests/Test/Massiv/Array/Numeric/IntegralSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/Numeric/IntegralSpec.hs @@ -12,7 +12,7 @@ gaussian x = exp (x ^ (2 :: Int)) spec :: Spec spec = do let (a, b) = (0, 2) - integrator rule = rule Seq N (gaussian .) a b (Sz1 1) + integrator rule = rule Seq BN (gaussian .) a b (Sz1 1) describe "Integral Approximation" $ do it "Midpoint Rule" $ do integrator midpointRule 4 `evaluate'` 0 `shouldBe` 14.485613 diff --git a/massiv-test/tests/Test/Massiv/Array/Ops/ConstructSpec.hs b/massiv-test/tests/Test/Massiv/Array/Ops/ConstructSpec.hs index b370aa88..4c295f0c 100644 --- a/massiv-test/tests/Test/Massiv/Array/Ops/ConstructSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/Ops/ConstructSpec.hs @@ -94,10 +94,10 @@ specConstructIx3 = do mkIntermediate :: Int -> Array U Ix1 Int mkIntermediate t = A.fromList Seq [t + 50, t + 75] -initArr :: Array N Ix1 (Array U Ix1 Int) +initArr :: Array BN Ix1 (Array U Ix1 Int) initArr = makeArray Seq (Sz1 3) mkIntermediate -initArr2 :: Array N Ix2 (Array U Ix1 Int) +initArr2 :: Array BN Ix2 (Array U Ix1 Int) initArr2 = makeArray Seq (Sz 2) (\ (x :. y) -> mkIntermediate (x+y)) prop_unfoldrList :: Sz1 -> Fun Word (Int, Word) -> Word -> Property diff --git a/massiv-test/tests/Test/Massiv/Array/Ops/MapSpec.hs b/massiv-test/tests/Test/Massiv/Array/Ops/MapSpec.hs index 724629a6..bd677234 100644 --- a/massiv-test/tests/Test/Massiv/Array/Ops/MapSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/Ops/MapSpec.hs @@ -139,7 +139,7 @@ spec = do alt_imapM - :: (Applicative f, Index ix, Mutable r2 b, Source r1 a) => + :: (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 (:) [] (zipWithIndex arr) where diff --git a/massiv-test/tests/Test/Massiv/Array/Ops/TransformSpec.hs b/massiv-test/tests/Test/Massiv/Array/Ops/TransformSpec.hs index 32b0cba4..f8f6b71c 100644 --- a/massiv-test/tests/Test/Massiv/Array/Ops/TransformSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/Ops/TransformSpec.hs @@ -20,7 +20,7 @@ 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, Mutable r e) + 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 @@ -29,7 +29,7 @@ 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), Mutable r e, Index ix) + 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 @@ -44,7 +44,7 @@ prop_SplitExtract :: , Show (Array r ix e) , Source r e , Load r ix e - , Mutable r e + , Manifest r e , Ragged L ix e ) => DimIx ix @@ -61,7 +61,7 @@ prop_SplitExtract (DimIx dim) (ArrIx arr ix) (Positive n) = (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, Mutable r Int) + 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 @@ -75,7 +75,7 @@ prop_ConcatAppend (DimIx dim) comp sz (NonEmpty fns) = prop_ConcatMConcatOuterM :: forall r ix. - (Eq (Array r ix Int), Show (Array r ix Int), Load r ix Int, Mutable r Int) + (Eq (Array r ix Int), Show (Array r ix Int), Load r ix Int, Manifest r Int) => Comp -> Sz ix -> NonEmptyList (Fun ix Int) @@ -169,7 +169,7 @@ prop_ZoomWithGridStrideCompute :: ( Eq (Array r ix e) , Show (Array r ix e) , StrideLoad r ix e - , Mutable r e + , Manifest r e ) => Array r ix e -> Stride ix @@ -185,7 +185,7 @@ prop_ZoomWithGridStrideCompute arr stride defVal = 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, Mutable r e) + 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 @@ -217,8 +217,8 @@ type Transform r ix e , Ragged L ix e , Source r e , StrideLoad r ix e - , Mutable r Int - , Mutable r e) + , Manifest r Int + , Manifest r e) specTransformR :: forall r ix e. Transform r ix e diff --git a/massiv-test/tests/Test/Massiv/Array/StencilSpec.hs b/massiv-test/tests/Test/Massiv/Array/StencilSpec.hs index d254f8c9..44ab1c0e 100644 --- a/massiv-test/tests/Test/Massiv/Array/StencilSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/StencilSpec.hs @@ -138,39 +138,39 @@ prop_FoldrStencil (ArrNE arr) = stencilSpec :: Spec stencilSpec = do describe "MapSingletonStencil" $ do - it "Ix1" $ property $ prop_MapSingletonStencil (Proxy :: Proxy Ix1) - it "Ix2" $ property $ prop_MapSingletonStencil (Proxy :: Proxy Ix2) - it "Ix3" $ property $ prop_MapSingletonStencil (Proxy :: Proxy Ix3) - it "Ix4" $ property $ prop_MapSingletonStencil (Proxy :: Proxy Ix4) + prop "Ix1" $ prop_MapSingletonStencil (Proxy :: Proxy Ix1) + prop "Ix2" $ prop_MapSingletonStencil (Proxy :: Proxy Ix2) + prop "Ix3" $ prop_MapSingletonStencil (Proxy :: Proxy Ix3) + prop "Ix4" $ prop_MapSingletonStencil (Proxy :: Proxy Ix4) describe "MapSingletonStencilWithStride" $ do - it "Ix1" $ property $ prop_MapSingletonStencilWithStride (Proxy :: Proxy Ix1) - it "Ix2" $ property $ prop_MapSingletonStencilWithStride (Proxy :: Proxy Ix2) - it "Ix3" $ property $ prop_MapSingletonStencilWithStride (Proxy :: Proxy Ix3) + prop "Ix1" $ prop_MapSingletonStencilWithStride (Proxy :: Proxy Ix1) + prop "Ix2" $ prop_MapSingletonStencilWithStride (Proxy :: Proxy Ix2) + prop "Ix3" $ prop_MapSingletonStencilWithStride (Proxy :: Proxy Ix3) describe "ApplyZeroStencil" $ do - it "Ix1" $ property $ prop_ApplyZeroStencil (Proxy :: Proxy Ix1) - it "Ix2" $ property $ prop_ApplyZeroStencil (Proxy :: Proxy Ix2) - it "Ix3" $ property $ prop_ApplyZeroStencil (Proxy :: Proxy Ix3) - it "Ix4" $ property $ prop_ApplyZeroStencil (Proxy :: Proxy Ix4) + prop "Ix1" $ prop_ApplyZeroStencil (Proxy :: Proxy Ix1) + prop "Ix2" $ prop_ApplyZeroStencil (Proxy :: Proxy Ix2) + prop "Ix3" $ prop_ApplyZeroStencil (Proxy :: Proxy Ix3) + prop "Ix4" $ prop_ApplyZeroStencil (Proxy :: Proxy Ix4) describe "DangerousStencil" $ do - it "Ix1" $ property $ prop_DangerousStencil (Proxy :: Proxy Ix1) - it "Ix2" $ property $ prop_DangerousStencil (Proxy :: Proxy Ix2) - it "Ix3" $ property $ prop_DangerousStencil (Proxy :: Proxy Ix3) - it "Ix4" $ property $ prop_DangerousStencil (Proxy :: Proxy Ix4) + prop "Ix1" $ prop_DangerousStencil (Proxy :: Proxy Ix1) + prop "Ix2" $ prop_DangerousStencil (Proxy :: Proxy Ix2) + prop "Ix3" $ prop_DangerousStencil (Proxy :: Proxy Ix3) + prop "Ix4" $ prop_DangerousStencil (Proxy :: Proxy Ix4) describe "MapEqApplyStencil" $ do - it "Ix1" $ property $ prop_MapEqApplyStencil @Ix1 - it "Ix2" $ property $ prop_MapEqApplyStencil @Ix2 - it "Ix3" $ property $ prop_MapEqApplyStencil @Ix3 - it "Ix4" $ property $ prop_MapEqApplyStencil @Ix4 + prop "Ix1" $ prop_MapEqApplyStencil @Ix1 + prop "Ix2" $ prop_MapEqApplyStencil @Ix2 + prop "Ix3" $ prop_MapEqApplyStencil @Ix3 + prop "Ix4" $ prop_MapEqApplyStencil @Ix4 describe "FoldrStencil" $ do - it "Ix1" $ property $ prop_FoldrStencil @Ix1 - it "Ix2" $ property $ prop_FoldrStencil @Ix2 - it "Ix3" $ property $ prop_FoldrStencil @Ix3 - it "Ix4" $ property $ prop_FoldrStencil @Ix4 + prop "Ix1" $ prop_FoldrStencil @Ix1 + prop "Ix2" $ prop_FoldrStencil @Ix2 + prop "Ix3" $ prop_FoldrStencil @Ix3 + prop "Ix4" $ prop_FoldrStencil @Ix4 describe "Simple" $ do - it "sumStencil" $ property $ \ (arr :: Array B Ix2 Rational) border -> - computeAs N (mapStencil border avg3x3Stencil arr) === - computeAs N (applyStencil (Padding 1 1 border) (avgStencil (Sz 3)) arr) - it "sameSizeAndCenter" $ property $ \ (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 diff --git a/massiv-test/tests/Test/Massiv/ArraySpec.hs b/massiv-test/tests/Test/Massiv/ArraySpec.hs index cca3b7d3..9ed2b103 100644 --- a/massiv-test/tests/Test/Massiv/ArraySpec.hs +++ b/massiv-test/tests/Test/Massiv/ArraySpec.hs @@ -98,29 +98,32 @@ specCommon :: => Spec specCommon = describe "Construct" $ do - it "Construct_makeArray B" $ property $ prop_Construct_makeArray_Manifest @B @ix - it "Construct_makeArray N" $ property $ prop_Construct_makeArray_Manifest @N @ix - it "Construct_makeArray S" $ property $ prop_Construct_makeArray_Manifest @S @ix - it "Construct_makeArray P" $ property $ prop_Construct_makeArray_Manifest @P @ix - it "Construct_makeArray U" $ property $ prop_Construct_makeArray_Manifest @U @ix - it "Construct_makeArray_Delayed DI" $ property $ prop_Construct_makeArray_Delayed @DI @ix - it "Construct_makeArray_Delayed DL" $ property $ prop_Construct_makeArray_Delayed @DL @ix - it "Construct_makeArray_Delayed DW" $ property $ prop_Construct_makeArray_Delayed @DW @ix - it "Functor D" $ property $ prop_Functor @D @ix - it "Functor DI" $ property $ prop_Functor @DI @ix - it "Functor DL" $ property $ prop_Functor @DL @ix - it "Functor DW" $ property $ prop_Functor @DW @ix - it "Extract B" $ property $ prop_Extract @B @ix - it "Extract N" $ property $ prop_Extract @N @ix - it "Extract S" $ property $ prop_Extract @S @ix - it "Extract U" $ property $ prop_Extract @U @ix - it "computeWithStride DI" $ property $ prop_computeWithStride @DI @ix - it "computeWithStride DW" $ property $ prop_computeWithStride @DW @ix - it "computeWithStride B" $ property $ prop_computeWithStride @B @ix - it "computeWithStride N" $ property $ prop_computeWithStride @N @ix - it "computeWithStride S" $ property $ prop_computeWithStride @S @ix - it "computeWithStride U" $ property $ prop_computeWithStride @U @ix - it "IxUnbox" $ property $ prop_IxUnbox @ix + prop "Construct_makeArray B" $ prop_Construct_makeArray_Manifest @B @ix + prop "Construct_makeArray BN" $ prop_Construct_makeArray_Manifest @BN @ix + prop "Construct_makeArray BL" $ prop_Construct_makeArray_Manifest @BL @ix + prop "Construct_makeArray S" $ prop_Construct_makeArray_Manifest @S @ix + prop "Construct_makeArray P" $ prop_Construct_makeArray_Manifest @P @ix + prop "Construct_makeArray U" $ prop_Construct_makeArray_Manifest @U @ix + prop "Construct_makeArray_Delayed DI" $ prop_Construct_makeArray_Delayed @DI @ix + prop "Construct_makeArray_Delayed DL" $ prop_Construct_makeArray_Delayed @DL @ix + prop "Construct_makeArray_Delayed DW" $ prop_Construct_makeArray_Delayed @DW @ix + prop "Functor D" $ prop_Functor @D @ix + prop "Functor DI" $ prop_Functor @DI @ix + prop "Functor DL" $ prop_Functor @DL @ix + prop "Functor DW" $ prop_Functor @DW @ix + prop "Extract B" $ prop_Extract @B @ix + prop "Extract BN" $ prop_Extract @BN @ix + prop "Extract BL" $ prop_Extract @BL @ix + prop "Extract S" $ prop_Extract @S @ix + prop "Extract U" $ prop_Extract @U @ix + prop "computeWithStride DI" $ prop_computeWithStride @DI @ix + prop "computeWithStride DW" $ prop_computeWithStride @DW @ix + prop "computeWithStride B" $ prop_computeWithStride @B @ix + prop "computeWithStride BN" $ prop_computeWithStride @BN @ix + prop "computeWithStride BL" $ prop_computeWithStride @BL @ix + prop "computeWithStride S" $ prop_computeWithStride @S @ix + prop "computeWithStride U" $ prop_computeWithStride @U @ix + prop "IxUnbox" $ prop_IxUnbox @ix spec :: Spec diff --git a/massiv-test/tests/Test/Massiv/VectorSpec.hs b/massiv-test/tests/Test/Massiv/VectorSpec.hs index c6e70f59..4f5596b5 100644 --- a/massiv-test/tests/Test/Massiv/VectorSpec.hs +++ b/massiv-test/tests/Test/Massiv/VectorSpec.hs @@ -418,7 +418,7 @@ prop_szipWith5 v1 v2 v3 v4 v5 f = prop_szipWith6 :: Vector DS Word64 -> Vector B Word32 - -> Vector N Word16 + -> Vector BN Word16 -> Vector S Word8 -> Vector U Int8 -> Vector P Int16 @@ -466,7 +466,7 @@ prop_sizipWith5 :: -> Vector S Word32 -> Vector P Word16 -> Vector U Word8 - -> Vector N Int8 + -> Vector BN Int8 -> Fun (Ix1, (Word64, Word32, Word16, Word8, Int8)) Int -> Property prop_sizipWith5 v1 v2 v3 v4 v5 f = @@ -476,8 +476,8 @@ prop_sizipWith5 v1 v2 v3 v4 v5 f = prop_sizipWith6 :: Vector DS Word64 -> Vector D Word32 - -> Vector B Word16 - -> Vector N Word8 + -> Vector BL Word16 + -> Vector BN Word8 -> Vector P Int8 -> Vector P Int16 -> Fun (Ix1, Word64, (Word32, Word16, Word8, Int8, Int16)) Int diff --git a/massiv/CHANGELOG.md b/massiv/CHANGELOG.md index 87e93781..8d82d249 100644 --- a/massiv/CHANGELOG.md +++ b/massiv/CHANGELOG.md @@ -43,6 +43,8 @@ * `mapIO_`, `imapIO_`, `forIO_` and `iforIO_` * `mapIO`, `imapIO`, `forIO` and `iforIO` * Add `Uniform`, `UniformRange` and `Random` instances for `Ix2`, `IxN`, `Dim`, `Sz` and `Stride` +* Consolidate `Mutable` into `Manifest` type class and move the `MArray` data + family outside of the class. # 0.6.1 diff --git a/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs b/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs index 73e27292..45dd1550 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs @@ -93,6 +93,8 @@ data instance Array BL ix e = BLArray { blComp :: !Comp , blOffset :: {-# UNPACK #-} !Int , blData :: {-# UNPACK #-} !(A.Array e) } +data instance MArray s BL ix e = + MBLArray !(Sz ix) {-# UNPACK #-} !Int {-# UNPACK #-} !(A.MutableArray s e) instance (Ragged L ix e, Show e) => Show (Array BL ix e) where showsPrec = showsArrayPrec id @@ -151,10 +153,6 @@ instance Manifest BL e where SafeSz . A.sizeofArray, A.indexArray) a (i + o) {-# INLINE unsafeLinearIndexM #-} - -instance Mutable BL e where - data MArray s BL ix e = MBLArray !(Sz ix) {-# UNPACK #-} !Int {-# UNPACK #-} !(A.MutableArray s e) - sizeOfMArray (MBLArray sz _ _) = sz {-# INLINE sizeOfMArray #-} @@ -180,12 +178,12 @@ instance Mutable BL e where {-# INLINE newMArray #-} unsafeLinearRead (MBLArray _ o ma) i = - INDEX_CHECK("(Mutable BL ix e).unsafeLinearRead", + INDEX_CHECK("(Manifest BL ix e).unsafeLinearRead", SafeSz . A.sizeofMutableArray, A.readArray) ma (i + o) {-# INLINE unsafeLinearRead #-} unsafeLinearWrite (MBLArray _sz o ma) i e = e `seq` - INDEX_CHECK("(Mutable BL ix e).unsafeLinearWrite", + INDEX_CHECK("(Manifest BL ix e).unsafeLinearWrite", SafeSz . A.sizeofMutableArray, A.writeArray) ma (i + o) e {-# INLINE unsafeLinearWrite #-} @@ -282,6 +280,8 @@ data B = B deriving Show newtype instance Array B ix e = BArray (Array BL ix e) +newtype instance MArray s B ix e = MBArray (MArray s BL ix e) + instance (Ragged L ix e, Show e) => Show (Array B ix e) where showsPrec = showsArrayPrec id showList = showArrayList @@ -333,10 +333,6 @@ instance Manifest B e where unsafeLinearIndexM = coerce unsafeLinearIndexM {-# INLINE unsafeLinearIndexM #-} - -instance Mutable B e where - newtype MArray s B ix e = MBArray (MArray s BL ix e) - sizeOfMArray = sizeOfMArray . coerce {-# INLINE sizeOfMArray #-} @@ -449,13 +445,17 @@ instance Num e => Numeric B e where data BN = BN deriving Show -- | Type and pattern `N` have been added for backwards compatibility and will be replaced --- in the future in favor of `BN` +-- in the future in favor of `BN`. +-- +-- /Deprecated/ - since 1.0.0 type N = BN pattern N :: N pattern N = BN {-# COMPLETE N #-} +{-# DEPRECATED N "In favor of more consistently named `BN`" #-} newtype instance Array BN ix e = BNArray (Array BL ix e) +newtype instance MArray s BN ix e = MBNArray (MArray s BL ix e) instance (Ragged L ix e, Show e, NFData e) => Show (Array BN ix e) where showsPrec = showsArrayPrec coerce @@ -505,10 +505,6 @@ instance NFData e => Manifest BN e where unsafeLinearIndexM arr = unsafeLinearIndexM (coerce arr) {-# INLINE unsafeLinearIndexM #-} - -instance NFData e => Mutable BN e where - newtype MArray s BN ix e = MBNArray (MArray s BL ix e) - sizeOfMArray = sizeOfMArray . coerce {-# INLINE sizeOfMArray #-} diff --git a/massiv/src/Data/Massiv/Array/Manifest/Internal.hs b/massiv/src/Data/Massiv/Array/Manifest/Internal.hs index 6357e399..c3029d65 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Internal.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Internal.hs @@ -57,7 +57,7 @@ import System.IO.Unsafe (unsafePerformIO) -- before calling @compute@ -- -- @since 0.1.0 -compute :: forall r ix e r' . (Mutable r e, Load r' ix e) => Array r' ix e -> Array r ix e +compute :: forall r ix e r' . (Manifest r e, Load r' ix e) => Array r' ix e -> Array r ix e compute !arr = unsafePerformIO $ computeIO arr {-# INLINE compute #-} @@ -65,7 +65,7 @@ compute !arr = unsafePerformIO $ computeIO arr -- the same as `computePrimM`, but executed in `ST`, thus pure. -- -- @since 0.1.0 -computeS :: forall r ix e r' . (Mutable r e, Load r' ix e) => Array r' ix e -> Array r ix e +computeS :: forall r ix e r' . (Manifest r e, Load r' ix e) => Array r' ix e -> Array r ix e computeS !arr = runST $ computePrimM arr {-# INLINE computeS #-} @@ -76,7 +76,7 @@ computeS !arr = runST $ computePrimM arr -- -- @since 0.5.4 computeP :: - forall r ix e r'. (Mutable r e, Load r' ix e) + forall r ix e r'. (Manifest r e, Load r' ix e) => Array r' ix e -> Array r ix e computeP arr = setComp (getComp arr) $ compute (setComp Par arr) @@ -89,7 +89,7 @@ computeP arr = setComp (getComp arr) $ compute (setComp Par arr) -- -- @since 0.4.5 computeIO :: - forall r ix e r' m. (Mutable r e, Load r' ix e, MonadIO m) + forall r ix e r' m. (Manifest r e, Load r' ix e, MonadIO m) => Array r' ix e -> m (Array r ix e) computeIO arr = liftIO (loadArray arr >>= unsafeFreeze (getComp arr)) @@ -100,7 +100,7 @@ computeIO arr = liftIO (loadArray arr >>= unsafeFreeze (getComp arr)) -- -- @since 0.4.5 computePrimM :: - forall r ix e r' m. (Mutable r e, Load r' ix e, PrimMonad m) + forall r ix e r' m. (Manifest r e, Load r' ix e, PrimMonad m) => Array r' ix e -> m (Array r ix e) computePrimM arr = loadArrayS arr >>= unsafeFreeze (getComp arr) @@ -116,7 +116,7 @@ computePrimM arr = loadArrayS arr >>= unsafeFreeze (getComp arr) -- Array P Seq (Sz1 10) -- [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9 ] -- -computeAs :: (Mutable r e, Load r' ix e) => r -> Array r' ix e -> Array r ix e +computeAs :: (Manifest r e, Load r' ix e) => r -> Array r' ix e -> Array r ix e computeAs _ = compute {-# INLINE computeAs #-} @@ -136,7 +136,7 @@ computeAs _ = compute -- [ 0, 1, 4, 9, 16, 25, 36, 49, 64, 81 ] -- -- @since 0.1.1 -computeProxy :: (Mutable r e, Load r' ix e) => proxy r -> Array r' ix e -> Array r ix e +computeProxy :: (Manifest r e, Load r' ix e) => proxy r -> Array r' ix e -> Array r ix e computeProxy _ = compute {-# INLINE computeProxy #-} @@ -145,7 +145,7 @@ computeProxy _ = compute -- resulting type is the same as the input. -- -- @since 0.1.0 -computeSource :: forall r ix e r' . (Mutable r e, Source r' e, Index ix) +computeSource :: forall r ix e r' . (Manifest r e, Source r' e, Index ix) => Array r' ix e -> Array r ix e computeSource arr = maybe (compute $ delay arr) (\Refl -> arr) (eqT :: Maybe (r' :~: r)) {-# INLINE computeSource #-} @@ -154,7 +154,7 @@ computeSource arr = maybe (compute $ delay arr) (\Refl -> arr) (eqT :: Maybe (r' -- | /O(n)/ - Make an exact immutable copy of an Array. -- -- @since 0.1.0 -clone :: (Mutable r e, Index ix) => Array r ix e -> Array r ix e +clone :: (Manifest r e, Index ix) => Array r ix e -> Array r ix e clone arr = unsafePerformIO $ thaw arr >>= unsafeFreeze (getComp arr) {-# INLINE clone #-} @@ -169,7 +169,7 @@ gcastArr arr = fmap (\Refl -> arr) (eqT :: Maybe (r :~: r')) -- result arrays are of the same representation, in which case it is an /O(1)/ operation. -- -- @since 0.1.0 -convert :: forall r ix e r' . (Mutable r e, Load r' ix e) +convert :: forall r ix e r' . (Manifest r e, Load r' ix e) => Array r' ix e -> Array r ix e convert arr = fromMaybe (compute arr) (gcastArr arr) {-# INLINE convert #-} @@ -177,7 +177,7 @@ convert arr = fromMaybe (compute arr) (gcastArr arr) -- | Same as `convert`, but let's you supply resulting representation type as an argument. -- -- @since 0.1.0 -convertAs :: (Mutable r e, Load r' ix e) +convertAs :: (Manifest r e, Load r' ix e) => r -> Array r' ix e -> Array r ix e convertAs _ = convert {-# INLINE convertAs #-} @@ -187,7 +187,7 @@ convertAs _ = convert -- proxy argument. -- -- @since 0.1.1 -convertProxy :: (Mutable r e, Load r' ix e) +convertProxy :: (Manifest r e, Load r' ix e) => proxy r -> Array r' ix e -> Array r ix e convertProxy _ = convert {-# INLINE convertProxy #-} @@ -198,7 +198,7 @@ convertProxy _ = convert -- -- @since 0.4.0 fromRaggedArrayM :: - forall r ix e r' m . (Mutable r e, Ragged r' ix e, MonadThrow m) + forall r ix e r' m . (Manifest r e, Ragged r' ix e, MonadThrow m) => Array r' ix e -> m (Array r ix e) fromRaggedArrayM arr = @@ -217,7 +217,7 @@ fromRaggedArrayM arr = -- -- @since 0.1.1 fromRaggedArray' :: - forall r ix e r'. (HasCallStack, Mutable r e, Ragged r' ix e) + forall r ix e r'. (HasCallStack, Manifest r e, Ragged r' ix e) => Array r' ix e -> Array r ix e fromRaggedArray' = throwEither . fromRaggedArrayM @@ -231,7 +231,7 @@ fromRaggedArray' = throwEither . fromRaggedArrayM -- -- @since 0.3.0 computeWithStride :: - forall r ix e r'. (Mutable r e, StrideLoad r' ix e) + forall r ix e r'. (Manifest r e, StrideLoad r' ix e) => Stride ix -> Array r' ix e -> Array r ix e @@ -247,7 +247,7 @@ computeWithStride stride !arr = -- -- @since 0.3.0 computeWithStrideAs :: - (Mutable r e, StrideLoad r' ix e) => r -> Stride ix -> Array r' ix e -> Array r ix e + (Manifest r e, StrideLoad r' ix e) => r -> Stride ix -> Array r' ix e -> Array r ix e computeWithStrideAs _ = computeWithStride {-# INLINE computeWithStrideAs #-} @@ -290,7 +290,7 @@ computeWithStrideAs _ = computeWithStride -- -- @since 0.3.6 iterateUntil :: - (Size r', Load r' ix e, Mutable r e) + (Size r', Load r' ix e, Manifest r e) => (Int -> Array r ix e -> Array r ix e -> Bool) -- ^ Convergence condition. Accepts current iteration counter, array at the previous -- state and at the current state. @@ -323,7 +323,7 @@ iterateUntil convergence iteration initArr0 -- -- @since 0.3.6 iterateUntilM :: - (Size r', Load r' ix e, Mutable r e, PrimMonad m, MonadIO m, PrimState m ~ RealWorld) + (Size r', Load r' ix e, Manifest r e, PrimMonad m, MonadIO m, PrimState m ~ RealWorld) => (Int -> Array r ix e -> MArray (PrimState m) r ix e -> m Bool) -- ^ Convergence condition. Accepts current iteration counter, pure array at previous -- state and a mutable at the current state, therefore after each iteration its contents @@ -349,7 +349,7 @@ iterateUntilM convergence iteration initArr0 = do iterateLoop :: - (Size r', Load r' ix e, Mutable r e, PrimMonad m, MonadIO m, PrimState m ~ RealWorld) + (Size r', Load r' ix e, Manifest r e, PrimMonad m, MonadIO m, PrimState m ~ RealWorld) => (Int -> Array r ix e -> Comp -> MArray (PrimState m) r ix e -> m Bool) -> (Int -> Array r ix e -> Array r' ix e) -> Int diff --git a/massiv/src/Data/Massiv/Array/Manifest/List.hs b/massiv/src/Data/Massiv/Array/Manifest/List.hs index dedfdb0d..d7e001b6 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/List.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/List.hs @@ -35,7 +35,7 @@ import qualified GHC.Exts as GHC (build, IsList(..)) -- -- @since 0.1.0 fromList :: - forall r e. Mutable r e + forall r e. Manifest r e => Comp -- ^ Computation startegy to use -> [e] -- ^ Flat list -> Vector r e @@ -81,7 +81,7 @@ fromList = fromLists' -- -- @since 0.3.0 fromListsM :: - forall r ix e m. (Ragged L ix e, Mutable r e, MonadThrow m) + forall r ix e m. (Ragged L ix e, Manifest r e, MonadThrow m) => Comp -> [ListItem ix e] -> m (Array r ix e) @@ -126,7 +126,7 @@ fromListToListArray = GHC.fromList -- -- @since 0.1.0 fromLists' :: - forall r ix e. (HasCallStack, Ragged L ix e, Mutable r e) + forall r ix e. (HasCallStack, Ragged L ix e, Manifest r e) => Comp -- ^ Computation startegy to use -> [ListItem ix e] -- ^ Nested list -> Array r ix e diff --git a/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs b/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs index ae0bbf29..c6199931 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs @@ -83,6 +83,9 @@ data instance Array P ix e = PArray { pComp :: !Comp , pData :: {-# UNPACK #-} !ByteArray } +data instance MArray s P ix e = + MPArray !(Sz ix) {-# UNPACK #-} !Int {-# UNPACK #-} !(MutableByteArray s) + instance (Ragged L ix e, Show e, Prim e) => Show (Array P ix e) where showsPrec = showsArrayPrec id showList = showArrayList @@ -135,6 +138,7 @@ instance Prim e => Source P e where unsafeLinearSlice i k (PArray c _ o a) = PArray c k (i + o) a {-# INLINE unsafeLinearSlice #-} + instance Prim e => Manifest P e where unsafeLinearIndexM _pa@(PArray _ _sz o a) i = @@ -142,10 +146,6 @@ instance Prim e => Manifest P e where const (Sz (totalElem _sz)), indexByteArray) a (i + o) {-# INLINE unsafeLinearIndexM #-} - -instance Prim e => Mutable P e where - data MArray s P ix e = MPArray !(Sz ix) {-# UNPACK #-} !Int {-# UNPACK #-} !(MutableByteArray s) - sizeOfMArray (MPArray sz _ _) = sz {-# INLINE sizeOfMArray #-} @@ -174,12 +174,12 @@ instance Prim e => Mutable P e where {-# INLINE initialize #-} unsafeLinearRead _mpa@(MPArray _sz o ma) i = - INDEX_CHECK("(Mutable P ix e).unsafeLinearRead", + INDEX_CHECK("(Manifest P ix e).unsafeLinearRead", const (Sz (totalElem _sz)), readByteArray) ma (i + o) {-# INLINE unsafeLinearRead #-} unsafeLinearWrite _mpa@(MPArray _sz o ma) i = - INDEX_CHECK("(Mutable P ix e).unsafeLinearWrite", + INDEX_CHECK("(Manifest P ix e).unsafeLinearWrite", const (Sz (totalElem _sz)), writeByteArray) ma (i + o) {-# INLINE unsafeLinearWrite #-} diff --git a/massiv/src/Data/Massiv/Array/Manifest/Storable.hs b/massiv/src/Data/Massiv/Array/Manifest/Storable.hs index 8f9d735c..3116813f 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Storable.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Storable.hs @@ -75,6 +75,8 @@ data instance Array S ix e = SArray { sComp :: !Comp , sData :: {-# UNPACK #-} !(ForeignPtr e) } +data instance MArray s S ix e = MSArray !(Sz ix) {-# UNPACK #-} !(ForeignPtr e) + instance (Ragged L ix e, Show e, Storable e) => Show (Array S ix e) where showsPrec = showsArrayPrec id showList = showArrayList @@ -135,16 +137,13 @@ instance Resize S where unsafeResize !sz !arr = arr { sSize = sz } {-# INLINE unsafeResize #-} + instance Storable e => Manifest S e where unsafeLinearIndexM (SArray _ _sz fp) = INDEX_CHECK("(Source S ix e).unsafeLinearIndex", const (toLinearSz _sz), indexForeignPtr) fp {-# INLINE unsafeLinearIndexM #-} - -instance Storable e => Mutable S e where - data MArray s S ix e = MSArray !(Sz ix) {-# UNPACK #-} !(ForeignPtr e) - sizeOfMArray (MSArray sz _) = sz {-# INLINE sizeOfMArray #-} @@ -177,11 +176,11 @@ instance Storable e => Mutable S e where {-# INLINE initialize #-} unsafeLinearRead (MSArray _sz fp) o = unsafeIOToPrim $ - INDEX_CHECK("(Mutable S ix e).unsafeLinearRead", const (toLinearSz _sz), (\_ _ -> unsafeWithForeignPtr fp (`peekElemOff` o))) fp o + INDEX_CHECK("(Manifest S ix e).unsafeLinearRead", const (toLinearSz _sz), (\_ _ -> unsafeWithForeignPtr fp (`peekElemOff` o))) fp o {-# INLINE unsafeLinearRead #-} unsafeLinearWrite (MSArray _sz fp) o e = unsafeIOToPrim $ - INDEX_CHECK("(Mutable S ix e).unsafeLinearWrite", const (toLinearSz _sz), (\_ _ -> unsafeWithForeignPtr fp (\p -> pokeElemOff p o e))) fp o + INDEX_CHECK("(Manifest S ix e).unsafeLinearWrite", const (toLinearSz _sz), (\_ _ -> unsafeWithForeignPtr fp (\p -> pokeElemOff p o e))) fp o {-# INLINE unsafeLinearWrite #-} unsafeLinearSet (MSArray _ fp) i k = diff --git a/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs b/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs index d4cc7de8..e1126e95 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs @@ -49,6 +49,7 @@ data instance Array U ix e = UArray { uComp :: !Comp , uSize :: !(Sz ix) , uData :: !(VU.Vector e) } +data instance MArray s U ix e = MUArray !(Sz ix) !(VU.MVector s e) instance (Ragged L ix e, Show e, Unbox e) => Show (Array U ix e) where showsPrec = showsArrayPrec id @@ -117,16 +118,15 @@ instance (Unbox e, Index ix) => Load U ix e where instance (Unbox e, Index ix) => StrideLoad U ix e + + + instance Unbox e => Manifest U e where unsafeLinearIndexM (UArray _ _ v) = INDEX_CHECK("(Manifest U ix e).unsafeLinearIndexM", Sz . VU.length, VU.unsafeIndex) v {-# INLINE unsafeLinearIndexM #-} - -instance Unbox e => Mutable U e where - data MArray s U ix e = MUArray !(Sz ix) !(VU.MVector s e) - sizeOfMArray (MUArray sz _) = sz {-# INLINE sizeOfMArray #-} @@ -153,11 +153,11 @@ instance Unbox e => Mutable U e where {-# INLINE unsafeLinearCopy #-} unsafeLinearRead (MUArray _ mv) = - INDEX_CHECK("(Mutable U ix e).unsafeLinearRead", Sz . MVU.length, MVU.unsafeRead) mv + INDEX_CHECK("(Manifest U ix e).unsafeLinearRead", Sz . MVU.length, MVU.unsafeRead) mv {-# INLINE unsafeLinearRead #-} unsafeLinearWrite (MUArray _ mv) = - INDEX_CHECK("(Mutable U ix e).unsafeLinearWrite", Sz . MVU.length, MVU.unsafeWrite) mv + INDEX_CHECK("(Manifest U ix e).unsafeLinearWrite", Sz . MVU.length, MVU.unsafeWrite) mv {-# INLINE unsafeLinearWrite #-} unsafeLinearGrow (MUArray _ mv) sz = MUArray sz <$> MVU.unsafeGrow mv (totalElem sz) diff --git a/massiv/src/Data/Massiv/Array/Manifest/Vector.hs b/massiv/src/Data/Massiv/Array/Manifest/Vector.hs index 334147d8..13f2b688 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Vector.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Vector.hs @@ -29,7 +29,6 @@ import Data.Massiv.Array.Manifest.Internal import Data.Massiv.Array.Manifest.Primitive import Data.Massiv.Array.Manifest.Storable import Data.Massiv.Array.Manifest.Unboxed -import Data.Massiv.Array.Mutable import Data.Massiv.Core.Common import Data.Maybe (fromMaybe) import Data.Typeable @@ -52,7 +51,7 @@ type family VRepr r :: Type -> Type where VRepr S = VS.Vector VRepr P = VP.Vector VRepr B = VB.Vector - VRepr N = VB.Vector + VRepr BN = VB.Vector VRepr BL = VB.Vector @@ -91,7 +90,7 @@ castFromVector comp sz vector = do -- -- @since 0.3.0 fromVectorM :: - (MonadThrow m, Typeable v, VG.Vector v a, Mutable r a, Load (ARepr v) ix a, Load r ix a) + (MonadThrow m, Typeable v, VG.Vector v a, Manifest r a, Load (ARepr v) ix a, Load r ix a) => Comp -> Sz ix -- ^ Resulting size of the array -> v a -- ^ Source Vector @@ -109,7 +108,7 @@ fromVectorM comp sz v = -- -- @since 0.3.0 fromVector' :: - (HasCallStack, Typeable v, VG.Vector v a, Load (ARepr v) ix a, Load r ix a, Mutable r a) + (HasCallStack, Typeable v, VG.Vector v a, Load (ARepr v) ix a, Load r ix a, Manifest r a) => Comp -> Sz ix -- ^ Resulting size of the array -> v a -- ^ Source Vector @@ -121,7 +120,7 @@ fromVector' comp sz = throwEither . fromVectorM comp sz -- return `Nothing` only if source array representation was not one of `B`, `N`, -- `P`, `S` or `U`. castToVector :: - forall v r ix e. (Mutable r e, Index ix, VRepr r ~ v) + forall v r ix e. (Manifest r e, Index ix, VRepr r ~ v) => Array r ix e -> Maybe (v e) castToVector arr = @@ -138,7 +137,7 @@ castToVector arr = , do Refl <- eqT :: Maybe (r :~: B) bArr <- gcastArr arr return $ toBoxedVector $ toLazyArray bArr - , do Refl <- eqT :: Maybe (r :~: N) + , do Refl <- eqT :: Maybe (r :~: BN) bArr <- gcastArr arr return $ toBoxedVector $ toLazyArray $ unwrapNormalForm bArr , do Refl <- eqT :: Maybe (r :~: BL) @@ -174,7 +173,7 @@ toVector :: forall r ix e v. ( Manifest r e , Load r ix e - , Mutable (ARepr v) e + , Manifest (ARepr v) e , VG.Vector v e , VRepr (ARepr v) ~ v ) diff --git a/massiv/src/Data/Massiv/Array/Mutable.hs b/massiv/src/Data/Massiv/Array/Mutable.hs index 38591526..4e8d5291 100644 --- a/massiv/src/Data/Massiv/Array/Mutable.hs +++ b/massiv/src/Data/Massiv/Array/Mutable.hs @@ -97,7 +97,7 @@ module Data.Massiv.Array.Mutable , initialize , initializeNew -- ** Computation - , Mutable + , Manifest , MArray , RealWorld , computeInto @@ -123,7 +123,7 @@ import Prelude hiding (mapM, read) -- -- @since 1.0.0 resizeMArrayM :: - (Mutable r e, Index ix', Index ix, MonadThrow m) + (Manifest r e, Index ix', Index ix, MonadThrow m) => Sz ix' -> MArray s r ix e -> m (MArray s r ix' e) @@ -137,7 +137,7 @@ resizeMArrayM sz marr = -- -- @since 1.0.0 outerSliceMArrayM :: - forall r ix e m s. (MonadThrow m, Index (Lower ix), Index ix, Mutable r e) + forall r ix e m s. (MonadThrow m, Index (Lower ix), Index ix, Manifest r e) => MArray s r ix e -> Ix1 -> m (MArray s r (Lower ix) e) @@ -203,7 +203,7 @@ outerSliceMArrayM !marr !i = do -- -- @since 1.0.0 outerSlicesMArray :: - forall r ix e s. (Index (Lower ix), Index ix, Mutable r e) + forall r ix e s. (Index (Lower ix), Index ix, Manifest r e) => Comp -> MArray s r ix e -> Vector D (MArray s r (Lower ix) e) @@ -242,7 +242,7 @@ outerSlicesMArray comp marr = -- -- @since 0.6.0 newMArray' :: - forall r ix e m. (Mutable r e, Index ix, PrimMonad m) + forall r ix e m. (Manifest r e, Index ix, PrimMonad m) => Sz ix -> m (MArray (PrimState m) r ix e) newMArray' sz = unsafeNew sz >>= \ma -> ma <$ initialize ma @@ -267,7 +267,7 @@ newMArray' sz = unsafeNew sz >>= \ma -> ma <$ initialize ma -- ] -- -- @since 0.1.0 -thaw :: forall r ix e m. (Mutable r e, Index ix, MonadIO m) => Array r ix e -> m (MArray RealWorld r ix e) +thaw :: forall r ix e m. (Manifest r e, Index ix, MonadIO m) => Array r ix e -> m (MArray RealWorld r ix e) thaw arr = liftIO $ do let sz = size arr @@ -299,7 +299,7 @@ thaw arr = -- -- @since 0.3.0 thawS :: - forall r ix e m. (Mutable r e, Index ix, PrimMonad m) + forall r ix e m. (Manifest r e, Index ix, PrimMonad m) => Array r ix e -> m (MArray (PrimState m) r ix e) thawS arr = do @@ -325,7 +325,7 @@ thawS arr = do -- -- @since 0.1.0 freeze :: - forall r ix e m. (Mutable r e, Index ix, MonadIO m) + forall r ix e m. (Manifest r e, Index ix, MonadIO m) => Comp -> MArray RealWorld r ix e -> m (Array r ix e) @@ -351,7 +351,7 @@ freeze comp smarr = -- -- @since 0.3.0 freezeS :: - forall r ix e m. (Mutable r e, Index ix, PrimMonad m) + forall r ix e m. (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> m (Array r ix e) freezeS smarr = do @@ -362,7 +362,7 @@ freezeS smarr = do {-# INLINE freezeS #-} unsafeNewUpper :: - (Load r' ix e, Mutable r e, PrimMonad m) => Array r' ix e -> m (MArray (PrimState m) r Ix1 e) + (Load r' ix e, Manifest r e, PrimMonad m) => Array r' ix e -> m (MArray (PrimState m) r Ix1 e) unsafeNewUpper !arr = unsafeNew (fromMaybe zeroSz (maxLinearSize arr)) {-# INLINE unsafeNewUpper #-} @@ -370,7 +370,7 @@ unsafeNewUpper !arr = unsafeNew (fromMaybe zeroSz (maxLinearSize arr)) -- -- @since 0.3.0 loadArrayS :: - forall r ix e r' m. (Load r' ix e, Mutable r e, PrimMonad m) + forall r ix e r' m. (Load r' ix e, Manifest r e, PrimMonad m) => Array r' ix e -> m (MArray (PrimState m) r ix e) loadArrayS arr = do @@ -383,7 +383,7 @@ loadArrayS arr = do -- -- @since 0.3.0 loadArray :: - forall r ix e r' m. (Load r' ix e, Mutable r e, MonadIO m) + forall r ix e r' m. (Load r' ix e, Manifest r e, MonadIO m) => Array r' ix e -> m (MArray RealWorld r ix e) loadArray arr = @@ -399,7 +399,7 @@ loadArray arr = -- -- @since 0.1.3 computeInto :: - (Size r', Load r' ix' e, Mutable r e, Index ix, MonadIO m) + (Size r', Load r' ix' e, Manifest r e, Index ix, MonadIO m) => MArray RealWorld r ix e -- ^ Target Array -> Array r' ix' e -- ^ Array to load -> m () @@ -416,7 +416,7 @@ computeInto !mArr !arr = -- -- @since 0.3.0 makeMArrayS :: - forall r ix e m. (Mutable r e, Index ix, PrimMonad m) + forall r ix e m. (Manifest r e, Index ix, PrimMonad m) => Sz ix -- ^ Size of the create array -> (ix -> m e) -- ^ Element generating action -> m (MArray (PrimState m) r ix e) @@ -428,7 +428,7 @@ makeMArrayS sz f = makeMArrayLinearS sz (f . fromLinearIndex sz) -- -- @since 0.3.0 makeMArrayLinearS :: - forall r ix e m. (Mutable r e, Index ix, PrimMonad m) + forall r ix e m. (Manifest r e, Index ix, PrimMonad m) => Sz ix -> (Int -> m e) -> m (MArray (PrimState m) r ix e) @@ -442,7 +442,7 @@ makeMArrayLinearS sz f = do -- -- @since 0.3.0 makeMArray :: - forall r ix e m. (MonadUnliftIO m, Mutable r e, Index ix) + forall r ix e m. (MonadUnliftIO m, Manifest r e, Index ix) => Comp -> Sz ix -> (ix -> m e) @@ -455,7 +455,7 @@ makeMArray comp sz f = makeMArrayLinear comp sz (f . fromLinearIndex sz) -- -- @since 0.3.0 makeMArrayLinear :: - forall r ix e m. (MonadUnliftIO m, Mutable r e, Index ix) + forall r ix e m. (MonadUnliftIO m, Manifest r e, Index ix) => Comp -> Sz ix -> (Int -> m e) @@ -485,7 +485,7 @@ makeMArrayLinear comp sz f = do -- @since 0.3.0 -- createArray_ :: - forall r ix e a m. (Mutable r e, Index ix, MonadUnliftIO m) + forall r ix e a m. (Manifest r e, Index ix, MonadUnliftIO m) => Comp -- ^ Computation strategy to use after `MArray` gets frozen and onward. -> Sz ix -- ^ Size of the newly created array -> (Scheduler RealWorld () -> MArray RealWorld r ix e -> m a) @@ -503,7 +503,7 @@ createArray_ comp sz action = do -- @since 0.3.0 -- createArray :: - forall r ix e a m b. (Mutable r e, Index ix, MonadUnliftIO m) + forall r ix e a m b. (Manifest r e, Index ix, MonadUnliftIO m) => Comp -- ^ Computation strategy to use after `MArray` gets frozen and onward. -> Sz ix -- ^ Size of the newly created array -> (Scheduler RealWorld a -> MArray RealWorld r ix e -> m b) @@ -530,7 +530,7 @@ createArray comp sz action = do -- -- @since 0.3.0 createArrayS_ :: - forall r ix e a m. (Mutable r e, Index ix, PrimMonad m) + forall r ix e a m. (Manifest r e, Index ix, PrimMonad m) => Sz ix -- ^ Size of the newly created array -> (MArray (PrimState m) r ix e -> m a) -- ^ An action that should fill all elements of the brand new mutable array @@ -542,7 +542,7 @@ createArrayS_ sz action = snd <$> createArrayS sz action -- -- @since 0.3.0 createArrayS :: - forall r ix e a m. (Mutable r e, Index ix, PrimMonad m) + forall r ix e a m. (Manifest r e, Index ix, PrimMonad m) => Sz ix -- ^ Size of the newly created array -> (MArray (PrimState m) r ix e -> m a) -- ^ An action that should fill all elements of the brand new mutable array @@ -558,7 +558,7 @@ createArrayS sz action = do -- -- @since 0.3.0 createArrayST_ :: - forall r ix e a. (Mutable r e, Index ix) + forall r ix e a. (Manifest r e, Index ix) => Sz ix -> (forall s. MArray s r ix e -> ST s a) -> Array r ix e @@ -570,7 +570,7 @@ createArrayST_ sz action = runST $ createArrayS_ sz action -- -- @since 0.2.6 createArrayST :: - forall r ix e a. (Mutable r e, Index ix) + forall r ix e a. (Manifest r e, Index ix) => Sz ix -> (forall s. MArray s r ix e -> ST s a) -> (a, Array r ix e) @@ -579,7 +579,7 @@ createArrayST sz action = runST $ createArrayS sz action -- | Sequentially generate a pure array. Much like `makeArray` creates a pure array this --- function will use `Mutable` interface to generate a pure `Array` in the end, except that +-- function will use `Manifest` interface to generate a pure `Array` in the end, except that -- computation strategy is set to `Seq`. Element producing function no longer has to be pure -- but is a stateful action, becuase it is restricted to `PrimMonad` thus allows for sharing -- the state between computation of each element. @@ -603,7 +603,7 @@ createArrayST sz action = runST $ createArrayS sz action -- -- @since 0.2.6 generateArrayS :: - forall r ix e m. (Mutable r e, Index ix, PrimMonad m) + forall r ix e m. (Manifest r e, Index ix, PrimMonad m) => Sz ix -- ^ Resulting size of the array -> (ix -> m e) -- ^ Element producing generator -> m (Array r ix e) @@ -614,7 +614,7 @@ generateArrayS sz gen = generateArrayLinearS sz (gen . fromLinearIndex sz) -- -- @since 0.3.0 generateArrayLinearS :: - forall r ix e m. (Mutable r e, Index ix, PrimMonad m) + forall r ix e m. (Manifest r e, Index ix, PrimMonad m) => Sz ix -- ^ Resulting size of the array -> (Int -> m e) -- ^ Element producing generator -> m (Array r ix e) @@ -630,7 +630,7 @@ generateArrayLinearS sz gen = do -- -- @since 0.2.6 generateArray :: - forall r ix e m. (MonadUnliftIO m, Mutable r e, Index ix) + forall r ix e m. (MonadUnliftIO m, Manifest r e, Index ix) => Comp -> Sz ix -> (ix -> m e) @@ -643,7 +643,7 @@ generateArray comp sz f = generateArrayLinear comp sz (f . fromLinearIndex sz) -- -- @since 0.3.0 generateArrayLinear :: - forall r ix e m. (MonadUnliftIO m, Mutable r e, Index ix) + forall r ix e m. (MonadUnliftIO m, Manifest r e, Index ix) => Comp -> Sz ix -> (Int -> m e) @@ -656,7 +656,7 @@ generateArrayLinear comp sz f = makeMArrayLinear comp sz f >>= liftIO . unsafeFr -- -- @since 0.3.4 generateArrayLinearWS :: - forall r ix e s m. (Mutable r e, Index ix, MonadUnliftIO m, PrimMonad m) + forall r ix e s m. (Manifest r e, Index ix, MonadUnliftIO m, PrimMonad m) => WorkerStates s -> Sz ix -> (Int -> s -> m e) @@ -677,7 +677,7 @@ generateArrayLinearWS states sz make = do -- -- @since 0.3.4 generateArrayWS :: - forall r ix e s m. (Mutable r e, Index ix, MonadUnliftIO m, PrimMonad m) + forall r ix e s m. (Manifest r e, Index ix, MonadUnliftIO m, PrimMonad m) => WorkerStates s -> Sz ix -> (ix -> s -> m e) @@ -710,7 +710,7 @@ generateArrayWS states sz make = generateArrayLinearWS states sz (make . fromLin -- -- @since 0.3.0 unfoldrPrimM_ :: - forall r ix e a m. (Mutable r e, Index ix, PrimMonad m) + forall r ix e a m. (Manifest r e, Index ix, PrimMonad m) => Sz ix -- ^ Size of the desired array -> (a -> m (e, a)) -- ^ Unfolding action -> a -- ^ Initial accumulator @@ -722,7 +722,7 @@ unfoldrPrimM_ sz gen acc0 = snd <$> unfoldrPrimM sz gen acc0 -- -- @since 0.3.0 iunfoldrPrimM_ :: - forall r ix e a m. (Mutable r e, Index ix, PrimMonad m) + forall r ix e a m. (Manifest r e, Index ix, PrimMonad m) => Sz ix -- ^ Size of the desired array -> (a -> ix -> m (e, a)) -- ^ Unfolding action -> a -- ^ Initial accumulator @@ -735,7 +735,7 @@ iunfoldrPrimM_ sz gen acc0 = snd <$> iunfoldrPrimM sz gen acc0 -- -- @since 0.3.0 iunfoldrPrimM :: - forall r ix e a m. (Mutable r e, Index ix, PrimMonad m) + forall r ix e a m. (Manifest r e, Index ix, PrimMonad m) => Sz ix -- ^ Size of the desired array -> (a -> ix -> m (e, a)) -- ^ Unfolding action -> a -- ^ Initial accumulator @@ -753,7 +753,7 @@ iunfoldrPrimM sz gen acc0 = -- -- @since 0.3.0 unfoldrPrimM :: - forall r ix e a m. (Mutable r e, Index ix, PrimMonad m) + forall r ix e a m. (Manifest r e, Index ix, PrimMonad m) => Sz ix -- ^ Size of the desired array -> (a -> m (e, a)) -- ^ Unfolding action -> a -- ^ Initial accumulator @@ -791,7 +791,7 @@ unfoldrPrimM sz gen acc0 = -- -- @since 0.3.0 unfoldlPrimM_ :: - forall r ix e a m. (Mutable r e, Index ix, PrimMonad m) + forall r ix e a m. (Manifest r e, Index ix, PrimMonad m) => Sz ix -- ^ Size of the desired array -> (a -> m (a, e)) -- ^ Unfolding action -> a -- ^ Initial accumulator @@ -803,7 +803,7 @@ unfoldlPrimM_ sz gen acc0 = snd <$> unfoldlPrimM sz gen acc0 -- -- @since 0.3.0 iunfoldlPrimM_ :: - forall r ix e a m. (Mutable r e, Index ix, PrimMonad m) + forall r ix e a m. (Manifest r e, Index ix, PrimMonad m) => Sz ix -- ^ Size of the desired array -> (a -> ix -> m (a, e)) -- ^ Unfolding action -> a -- ^ Initial accumulator @@ -816,7 +816,7 @@ iunfoldlPrimM_ sz gen acc0 = snd <$> iunfoldlPrimM sz gen acc0 -- -- @since 0.3.0 iunfoldlPrimM :: - forall r ix e a m. (Mutable r e, Index ix, PrimMonad m) + forall r ix e a m. (Manifest r e, Index ix, PrimMonad m) => Sz ix -- ^ Size of the desired array -> (a -> ix -> m (a, e)) -- ^ Unfolding action -> a -- ^ Initial accumulator @@ -834,7 +834,7 @@ iunfoldlPrimM sz gen acc0 = -- -- @since 0.3.0 unfoldlPrimM :: - forall r ix e a m. (Mutable r e, Index ix, PrimMonad m) + forall r ix e a m. (Manifest r e, Index ix, PrimMonad m) => Sz ix -- ^ Size of the desired array -> (a -> m (a, e)) -- ^ Unfolding action -> a -- ^ Initial accumulator @@ -852,7 +852,7 @@ unfoldlPrimM sz gen acc0 = -- action to it. There is no mutation to the array, unless the action itself modifies it. -- -- @since 0.4.0 -forPrimM_ :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (e -> m ()) -> m () +forPrimM_ :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (e -> m ()) -> m () forPrimM_ marr f = loopM_ 0 (< totalElem (sizeOfMArray marr)) (+1) (unsafeLinearRead marr >=> f) {-# INLINE forPrimM_ #-} @@ -860,7 +860,7 @@ forPrimM_ marr f = -- | Sequentially loop over a mutable array while modifying each element with an action. -- -- @since 0.4.0 -forPrimM :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (e -> m e) -> m () +forPrimM :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (e -> m e) -> m () forPrimM marr f = loopM_ 0 (< totalElem (sizeOfMArray marr)) (+1) (unsafeLinearModify marr f) {-# INLINE forPrimM #-} @@ -872,7 +872,7 @@ forPrimM marr f = -- -- @since 0.4.0 iforPrimM_ :: - (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (ix -> e -> m ()) -> m () + (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (ix -> e -> m ()) -> m () iforPrimM_ marr f = iforLinearPrimM_ marr (f . fromLinearIndex (sizeOfMArray marr)) {-# INLINE iforPrimM_ #-} @@ -880,7 +880,7 @@ iforPrimM_ marr f = iforLinearPrimM_ marr (f . fromLinearIndex (sizeOfMArray mar -- -- @since 0.4.0 iforPrimM :: - (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (ix -> e -> m e) -> m () + (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (ix -> e -> m e) -> m () iforPrimM marr f = iforLinearPrimM marr (f . fromLinearIndex (sizeOfMArray marr)) {-# INLINE iforPrimM #-} @@ -891,7 +891,7 @@ iforPrimM marr f = iforLinearPrimM marr (f . fromLinearIndex (sizeOfMArray marr) -- -- @since 0.4.0 iforLinearPrimM_ :: - (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (Int -> e -> m ()) -> m () + (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (Int -> e -> m ()) -> m () iforLinearPrimM_ marr f = loopM_ 0 (< totalElem (sizeOfMArray marr)) (+ 1) (\i -> unsafeLinearRead marr i >>= f i) {-# INLINE iforLinearPrimM_ #-} @@ -900,7 +900,7 @@ iforLinearPrimM_ marr f = -- -- @since 0.4.0 iforLinearPrimM :: - (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (Int -> e -> m e) -> m () + (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (Int -> e -> m e) -> m () iforLinearPrimM marr f = loopM_ 0 (< totalElem (sizeOfMArray marr)) (+ 1) (\i -> unsafeLinearModify marr (f i) i) {-# INLINE iforLinearPrimM #-} @@ -913,7 +913,7 @@ iforLinearPrimM marr f = -- -- @since 1.0.0 for2PrimM_ :: - forall r1 r2 e1 e2 ix m. (PrimMonad m, Index ix, Mutable r1 e1, Mutable r2 e2) + forall r1 r2 e1 e2 ix m. (PrimMonad m, Index ix, Manifest r1 e1, Manifest r2 e2) => MArray (PrimState m) r1 ix e1 -> MArray (PrimState m) r2 ix e2 -> (e1 -> e2 -> m ()) @@ -925,7 +925,7 @@ for2PrimM_ m1 m2 f = ifor2PrimM_ m1 m2 (const f) -- -- @since 1.0.0 ifor2PrimM_ :: - forall r1 r2 e1 e2 ix m. (PrimMonad m, Index ix, Mutable r1 e1, Mutable r2 e2) + forall r1 r2 e1 e2 ix m. (PrimMonad m, Index ix, Manifest r1 e1, Manifest r2 e2) => MArray (PrimState m) r1 ix e1 -> MArray (PrimState m) r2 ix e2 -> (ix -> e1 -> e2 -> m ()) @@ -943,7 +943,7 @@ ifor2PrimM_ m1 m2 f = do -- -- @since 0.5.0 withMArray :: - (Mutable r e, Index ix, MonadUnliftIO m) + (Manifest r e, Index ix, MonadUnliftIO m) => Array r ix e -> (Scheduler RealWorld a -> MArray RealWorld r ix e -> m b) -> m ([a], Array r ix e) @@ -967,7 +967,7 @@ withMArray arr action = do -- -- @since 0.5.0 withMArray_ :: - (Mutable r e, Index ix, MonadUnliftIO m) + (Manifest r e, Index ix, MonadUnliftIO m) => Array r ix e -> (Scheduler RealWorld () -> MArray RealWorld r ix e -> m a) -> m (Array r ix e) @@ -983,7 +983,7 @@ withMArray_ arr action = do -- -- @since 0.6.1 withLoadMArray_ :: - forall r ix e r' m b. (Load r' ix e, Mutable r e, MonadUnliftIO m) + forall r ix e r' m b. (Load r' ix e, Manifest r e, MonadUnliftIO m) => Array r' ix e -> (Scheduler RealWorld () -> MArray RealWorld r ix e -> m b) -> m (Array r ix e) @@ -1004,7 +1004,7 @@ withLoadMArray_ arr action = do -- -- @since 0.5.0 withMArrayS :: - (Mutable r e, Index ix, PrimMonad m) + (Manifest r e, Index ix, PrimMonad m) => Array r ix e -> (MArray (PrimState m) r ix e -> m a) -> m (a, Array r ix e) @@ -1019,7 +1019,7 @@ withMArrayS arr action = do -- -- @since 0.5.0 withMArrayS_ :: - (Mutable r e, Index ix, PrimMonad m) + (Manifest r e, Index ix, PrimMonad m) => Array r ix e -> (MArray (PrimState m) r ix e -> m a) -> m (Array r ix e) @@ -1031,7 +1031,7 @@ withMArrayS_ arr action = snd <$> withMArrayS arr action -- -- @since 0.6.1 withLoadMArrayS :: - forall r ix e r' m a. (Load r' ix e, Mutable r e, PrimMonad m) + forall r ix e r' m a. (Load r' ix e, Manifest r e, PrimMonad m) => Array r' ix e -> (MArray (PrimState m) r ix e -> m a) -> m (a, Array r ix e) @@ -1045,7 +1045,7 @@ withLoadMArrayS arr action = do -- -- @since 0.6.1 withLoadMArrayS_ :: - forall r ix e r' m a. (Load r' ix e, Mutable r e, PrimMonad m) + forall r ix e r' m a. (Load r' ix e, Manifest r e, PrimMonad m) => Array r' ix e -> (MArray (PrimState m) r ix e -> m a) -> m (Array r ix e) @@ -1058,7 +1058,7 @@ withLoadMArrayS_ arr action = snd <$> withLoadMArrayS arr action -- -- @since 0.5.0 withMArrayST :: - (Mutable r e, Index ix) + (Manifest r e, Index ix) => Array r ix e -> (forall s . MArray s r ix e -> ST s a) -> (a, Array r ix e) @@ -1070,7 +1070,7 @@ withMArrayST arr f = runST $ withMArrayS arr f -- -- @since 0.5.0 withMArrayST_ :: - (Mutable r e, Index ix) => Array r ix e -> (forall s. MArray s r ix e -> ST s a) -> Array r ix e + (Manifest r e, Index ix) => Array r ix e -> (forall s. MArray s r ix e -> ST s a) -> Array r ix e withMArrayST_ arr f = runST $ withMArrayS_ arr f {-# INLINE withMArrayST_ #-} @@ -1079,7 +1079,7 @@ withMArrayST_ arr f = runST $ withMArrayS_ arr f -- -- @since 0.6.1 withLoadMArrayST :: - forall r ix e r' a. (Load r' ix e, Mutable r e) + forall r ix e r' a. (Load r' ix e, Manifest r e) => Array r' ix e -> (forall s. MArray s r ix e -> ST s a) -> (a, Array r ix e) @@ -1090,7 +1090,7 @@ withLoadMArrayST arr f = runST $ withLoadMArrayS arr f -- -- @since 0.6.1 withLoadMArrayST_ :: - forall r ix e r' a. (Load r' ix e, Mutable r e) + forall r ix e r' a. (Load r' ix e, Manifest r e) => Array r' ix e -> (forall s. MArray s r ix e -> ST s a) -> Array r ix e @@ -1101,7 +1101,7 @@ withLoadMArrayST_ arr f = runST $ withLoadMArrayS_ arr f -- | /O(1)/ - Lookup an element in the mutable array. Returns `Nothing` when index is out of bounds. -- -- @since 0.1.0 -read :: (Mutable r e, Index ix, PrimMonad m) => +read :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> m (Maybe e) read marr ix = if isSafeIndex (sizeOfMArray marr) ix @@ -1113,7 +1113,7 @@ read marr ix = -- | /O(1)/ - Same as `read`, but throws `IndexOutOfBoundsException` on an invalid index. -- -- @since 0.4.0 -readM :: (Mutable r e, Index ix, PrimMonad m, MonadThrow m) => +readM :: (Manifest r e, Index ix, PrimMonad m, MonadThrow m) => MArray (PrimState m) r ix e -> ix -> m e readM marr ix = read marr ix >>= \case @@ -1126,7 +1126,7 @@ readM marr ix = -- of bounds. -- -- @since 0.1.0 -write :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> e -> m Bool +write :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> e -> m Bool write marr ix e = if isSafeIndex (sizeOfMArray marr) ix then unsafeWrite marr ix e >> pure True @@ -1139,7 +1139,7 @@ write marr ix e = -- words, just like `writeM`, but doesn't throw an exception. -- -- @since 0.4.4 -write_ :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> e -> m () +write_ :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> e -> m () write_ marr ix = when (isSafeIndex (sizeOfMArray marr) ix) . unsafeWrite marr ix {-# INLINE write_ #-} @@ -1147,7 +1147,7 @@ write_ marr ix = when (isSafeIndex (sizeOfMArray marr) ix) . unsafeWrite marr ix -- -- @since 0.4.0 writeM :: - (Mutable r e, Index ix, PrimMonad m, MonadThrow m) => MArray (PrimState m) r ix e -> ix -> e -> m () + (Manifest r e, Index ix, PrimMonad m, MonadThrow m) => MArray (PrimState m) r ix e -> ix -> e -> m () writeM marr ix e = write marr ix e >>= (`unless` throwM (IndexOutOfBoundsException (sizeOfMArray marr) ix)) {-# INLINE writeM #-} @@ -1158,7 +1158,7 @@ writeM marr ix e = -- -- @since 0.1.0 modify :: - (Mutable r e, Index ix, PrimMonad m) + (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -- ^ Array to mutate. -> (e -> m e) -- ^ Monadic action that modifies the element -> ix -- ^ Index at which to perform modification. @@ -1175,7 +1175,7 @@ modify marr f ix = -- -- @since 0.4.4 modify_ :: - (Mutable r e, Index ix, PrimMonad m) + (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -- ^ Array to mutate. -> (e -> m e) -- ^ Monadic action that modifies the element -> ix -- ^ Index at which to perform modification. @@ -1189,7 +1189,7 @@ modify_ marr f ix = when (isSafeIndex (sizeOfMArray marr) ix) $ void $ unsafeMod -- -- @since 0.4.0 modifyM :: - (Mutable r e, Index ix, PrimMonad m, MonadThrow m) + (Manifest r e, Index ix, PrimMonad m, MonadThrow m) => MArray (PrimState m) r ix e -- ^ Array to mutate. -> (e -> m e) -- ^ Monadic action that modifies the element -> ix -- ^ Index at which to perform modification. @@ -1212,7 +1212,7 @@ modifyM marr f ix -- -- @since 0.4.0 modifyM_ :: - (Mutable r e, Index ix, PrimMonad m, MonadThrow m) + (Manifest r e, Index ix, PrimMonad m, MonadThrow m) => MArray (PrimState m) r ix e -- ^ Array to mutate. -> (e -> m e) -- ^ Monadic action that modifies the element -> ix -- ^ Index at which to perform modification. @@ -1226,7 +1226,7 @@ modifyM_ marr f ix = void $ modifyM marr f ix -- otherwise. -- -- @since 0.1.0 -swap :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> ix -> m (Maybe (e, e)) +swap :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> ix -> m (Maybe (e, e)) swap marr ix1 ix2 = let !sz = sizeOfMArray marr in if isSafeIndex sz ix1 && isSafeIndex sz ix2 @@ -1239,7 +1239,7 @@ swap marr ix1 ix2 = -- words, it is similar to `swapM_`, but does not throw any exceptions. -- -- @since 0.4.4 -swap_ :: (Mutable r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> ix -> m () +swap_ :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> ix -> m () swap_ marr ix1 ix2 = let !sz = sizeOfMArray marr in when (isSafeIndex sz ix1 && isSafeIndex sz ix2) $ void $ unsafeSwap marr ix1 ix2 @@ -1251,7 +1251,7 @@ swap_ marr ix1 ix2 = -- -- @since 0.4.0 swapM :: - (Mutable r e, Index ix, PrimMonad m, MonadThrow m) + (Manifest r e, Index ix, PrimMonad m, MonadThrow m) => MArray (PrimState m) r ix e -> ix -- ^ Index for the first element, which will be returned as the first element in the -- tuple. @@ -1271,7 +1271,7 @@ swapM marr ix1 ix2 -- -- @since 0.4.0 swapM_ :: - (Mutable r e, Index ix, PrimMonad m, MonadThrow m) + (Manifest r e, Index ix, PrimMonad m, MonadThrow m) => MArray (PrimState m) r ix e -> ix -> ix @@ -1284,7 +1284,7 @@ swapM_ marr ix1 ix2 = void $ swapM marr ix1 ix2 -- -- @since 1.0.0 zipSwapM_ :: - forall r1 r2 ix e m s. (MonadPrim s m, Mutable r2 e, Mutable r1 e, Index ix) + forall r1 r2 ix e m s. (MonadPrim s m, Manifest r2 e, Manifest r1 e, Index ix) => ix -> MArray s r1 ix e -> MArray s r2 ix e @@ -1305,6 +1305,6 @@ zipSwapM_ startIx m1 m2 = do -- | Get the size of a mutable array. -- -- @since 0.1.0 -msize :: (Mutable r e, Index ix) => MArray s r ix e -> Sz ix +msize :: (Manifest r e, Index ix) => MArray s r ix e -> Sz ix msize = sizeOfMArray {-# DEPRECATED msize "In favor of `sizeOfMArray`" #-} diff --git a/massiv/src/Data/Massiv/Array/Mutable/Algorithms.hs b/massiv/src/Data/Massiv/Array/Mutable/Algorithms.hs index 7d6c26a8..a5ec8e45 100644 --- a/massiv/src/Data/Massiv/Array/Mutable/Algorithms.hs +++ b/massiv/src/Data/Massiv/Array/Mutable/Algorithms.hs @@ -36,7 +36,7 @@ import Data.Massiv.Core.Common -- -- @since 1.0.0 unstablePartitionM :: - forall r e m. (Mutable r e, PrimMonad m) + forall r e m. (Manifest r e, PrimMonad m) => MVector (PrimState m) r e -> (e -> m Bool) -- ^ Predicate -> m Ix1 diff --git a/massiv/src/Data/Massiv/Array/Mutable/Internal.hs b/massiv/src/Data/Massiv/Array/Mutable/Internal.hs index db484c96..adf2fe28 100644 --- a/massiv/src/Data/Massiv/Array/Mutable/Internal.hs +++ b/massiv/src/Data/Massiv/Array/Mutable/Internal.hs @@ -21,7 +21,7 @@ import Data.Massiv.Core.Common -- -- @since 0.5.0 unsafeCreateArrayS :: - forall r ix e a m. (Mutable r e, Index ix, PrimMonad m) + forall r ix e a m. (Manifest r e, Index ix, PrimMonad m) => Sz ix -- ^ Size of the newly created array -> (MArray (PrimState m) r ix e -> m a) -- ^ An action that should fill all elements of the brand new mutable array @@ -38,7 +38,7 @@ unsafeCreateArrayS sz action = do -- -- @since 0.5.0 unsafeCreateArray :: - forall r ix e a m b. (Mutable r e, Index ix, MonadUnliftIO m) + forall r ix e a m b. (Manifest r e, Index ix, MonadUnliftIO m) => Comp -- ^ Computation strategy to use after `MArray` gets frozen and onward. -> Sz ix -- ^ Size of the newly created array -> (Scheduler RealWorld a -> MArray RealWorld r ix e -> m b) @@ -56,7 +56,7 @@ unsafeCreateArray comp sz action = do -- -- @since 0.5.0 unsafeCreateArray_ :: - forall r ix e a m b. (Mutable r e, Index ix, MonadUnliftIO m) + forall r ix e a m b. (Manifest r e, Index ix, MonadUnliftIO m) => Comp -- ^ Computation strategy to use after `MArray` gets frozen and onward. -> Sz ix -- ^ Size of the newly created array -> (Scheduler RealWorld a -> MArray RealWorld r ix e -> m b) diff --git a/massiv/src/Data/Massiv/Array/Numeric.hs b/massiv/src/Data/Massiv/Array/Numeric.hs index 96ed356d..da02b4ac 100644 --- a/massiv/src/Data/Massiv/Array/Numeric.hs +++ b/massiv/src/Data/Massiv/Array/Numeric.hs @@ -100,7 +100,6 @@ module Data.Massiv.Array.Numeric ) where import Data.Massiv.Array.Mutable -import Data.Massiv.Array.Manifest import Data.Massiv.Array.Delayed.Pull import Data.Massiv.Array.Delayed.Push import Data.Massiv.Array.Manifest.Internal @@ -425,7 +424,7 @@ powerSumArrayIO v p = do -- -- @since 0.5.7 multiplyMatrixByVector :: - (MonadThrow m, Numeric r e, Mutable r e) + (MonadThrow m, Numeric r e, Manifest r e) => Matrix r e -- ^ Matrix -> Vector r e -- ^ Column vector (Used many times, so make sure it is computed) -> m (Vector r e) @@ -453,7 +452,7 @@ multiplyMatrixByVector mm v = compute <$> mm .>< v -- /__Throws Exception__/: `SizeMismatchException` when inner dimensions of arrays do not match. -- -- @since 0.5.6 -(><.) :: (MonadThrow m, Numeric r e, Mutable r e) => +(><.) :: (MonadThrow m, Numeric r e, Manifest r e) => Vector r e -- ^ Row vector -> Matrix r e -- ^ Matrix -> m (Vector r e) @@ -467,7 +466,7 @@ multiplyMatrixByVector mm v = compute <$> mm .>< v -- -- @since 0.5.7 multiplyVectorByMatrix :: - (MonadThrow m, Numeric r e, Mutable r e) + (MonadThrow m, Numeric r e, Manifest r e) => Vector r e -- ^ Row vector -> Matrix r e -- ^ Matrix -> m (Vector r e) @@ -504,7 +503,7 @@ multiplyVectorByMatrix v mm -- -- @since 0.5.6 (> Vector r e -- ^ Row vector (Used many times, so make sure it is computed) -> Matrix r e -- ^ Matrix -> Vector r e @@ -531,7 +530,7 @@ multiplyVectorByMatrix v mm -- ] -- -- @since 0.5.6 -(!> Matrix r e -> Matrix r e -> Matrix r e +(!> Matrix r e -> Matrix r e -> Matrix r e (!><.) :: (Numeric r e, Mutable r e, MonadThrow m) => Matrix r e -> Matrix r e -> m (Matrix r e) +(.><.) :: (Numeric r e, Manifest r e, MonadThrow m) => Matrix r e -> Matrix r e -> m (Matrix r e) (.><.) = multiplyMatrices {-# INLINE (.><.) #-} @@ -550,7 +549,7 @@ multiplyVectorByMatrix v mm -- -- @since 0.5.6 multiplyMatrices :: - (Numeric r e, Mutable r e, MonadThrow m) => Matrix r e -> Matrix r e -> m (Matrix r e) + (Numeric r e, Manifest r e, MonadThrow m) => Matrix r e -> Matrix r e -> m (Matrix r e) multiplyMatrices arrA arrB -- mA == 1 = -- TODO: call multiplyVectorByMatrix -- nA == 1 = -- TODO: call multiplyMatrixByVector diff --git a/massiv/src/Data/Massiv/Array/Numeric/Integral.hs b/massiv/src/Data/Massiv/Array/Numeric/Integral.hs index 452bf280..972fe9e1 100644 --- a/massiv/src/Data/Massiv/Array/Numeric/Integral.hs +++ b/massiv/src/Data/Massiv/Array/Numeric/Integral.hs @@ -111,7 +111,7 @@ simpsonsStencil dx dim n -- | Integrate with a stencil along a particular dimension. integrateWith :: - (Fractional e, StrideLoad DW ix e, Mutable r e) + (Fractional e, StrideLoad DW ix e, Manifest r e) => (Dim -> Int -> Stencil ix e e) -> Dim -- ^ Dimension along which integration should be estimated. -> Int -- ^ @n@ - Number of samples @@ -126,7 +126,7 @@ integrateWith stencil dim n arr = -- | Compute an approximation of integral using a supplied rule in a form of `Stencil`. integralApprox :: - (Fractional e, StrideLoad DW ix e, Mutable r e) + (Fractional e, StrideLoad DW ix e, Manifest r e) => (e -> Dim -> Int -> Stencil ix e e) -- ^ Integration Stencil -> e -- ^ @d@ - Length of interval per cell -> Sz ix -- ^ @sz@ - Result size of the matrix @@ -144,7 +144,7 @@ integralApprox stencil d sz n arr = -- | Use midpoint rule to approximate an integral. midpointRule :: - (Fractional e, StrideLoad DW ix e, Mutable r e) + (Fractional e, StrideLoad DW ix e, Manifest r e) => Comp -- ^ Computation strategy. -> r -- ^ Intermediate array representation. -> ((Int -> e) -> ix -> e) -- ^ @f(x,y,...)@ - Function to integrate @@ -160,7 +160,7 @@ midpointRule comp r f a d sz n = -- | Use trapezoid rule to approximate an integral. trapezoidRule :: - (Fractional e, StrideLoad DW ix e, Mutable r e) + (Fractional e, StrideLoad DW ix e, Manifest r e) => Comp -- ^ Computation strategy -> r -- ^ Intermediate array representation -> ((Int -> e) -> ix -> e) -- ^ @f(x,y,...)@ - function to integrate @@ -175,7 +175,7 @@ trapezoidRule comp r f a d sz n = -- | Use Simpson's rule to approximate an integral. simpsonsRule :: - (Fractional e, StrideLoad DW ix e, Mutable r e) + (Fractional e, StrideLoad DW ix e, Manifest r e) => Comp -- ^ Computation strategy -> r -- ^ Intermediate array representation -> ((Int -> e) -> ix -> e) -- ^ @f(x,y,...)@ - Function to integrate diff --git a/massiv/src/Data/Massiv/Array/Ops/Construct.hs b/massiv/src/Data/Massiv/Array/Ops/Construct.hs index 5f3be998..9285e413 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Construct.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Construct.hs @@ -118,7 +118,7 @@ makeVectorR _ = makeArray newtype STA r ix a = STA {_runSTA :: forall s. MArray s r ix a -> ST s (Array r ix a)} -runSTA :: (Mutable r e, Index ix) => Sz ix -> STA r ix e -> Array r ix e +runSTA :: (Manifest r e, Index ix) => Sz ix -> STA r ix e -> Array r ix e runSTA !sz (STA m) = runST (unsafeNew sz >>= m) {-# INLINE runSTA #-} @@ -130,7 +130,7 @@ runSTA !sz (STA m) = runST (unsafeNew sz >>= m) -- -- @since 0.2.6 makeArrayA :: - forall r ix e f. (Mutable r e, Index ix, Applicative f) + forall r ix e f. (Manifest r e, Index ix, Applicative f) => Sz ix -> (ix -> f e) -> f (Array r ix e) @@ -150,7 +150,7 @@ makeArrayA !sz f = -- -- @since 0.4.5 makeArrayLinearA :: - forall r ix e f. (Mutable r e, Index ix, Applicative f) + forall r ix e f. (Manifest r e, Index ix, Applicative f) => Sz ix -> (Int -> f e) -> f (Array r ix e) @@ -168,7 +168,7 @@ makeArrayLinearA !sz f = -- -- @since 0.2.6 makeArrayAR :: - forall r ix e f. (Mutable r e, Index ix, Applicative f) + forall r ix e f. (Manifest r e, Index ix, Applicative f) => r -> Sz ix -> (ix -> f e) @@ -395,7 +395,7 @@ uniformRangeArray gen r = randomArray gen split (uniformR r) -- -- @since 0.3.4 randomArrayS :: - forall r ix e g. (Mutable r e, Index ix) + forall r ix e g. (Manifest r e, Index ix) => g -- ^ Initial random value generator -> Sz ix -- ^ Resulting size of the array. -> (g -> (e, g)) @@ -439,7 +439,7 @@ randomArrayS gen sz nextRandom = -- -- @since 0.3.4 randomArrayWS :: - forall r ix e g m. (Mutable r e, Index ix, MonadUnliftIO m, PrimMonad m) + forall r ix e g m. (Manifest r e, Index ix, MonadUnliftIO m, PrimMonad m) => WorkerStates g -- ^ Use `initWorkerStates` to initialize you per thread generators -> Sz ix -- ^ Resulting size of the array -> (g -> m e) -- ^ Generate the value using the per thread generator. diff --git a/massiv/src/Data/Massiv/Array/Ops/Map.hs b/massiv/src/Data/Massiv/Array/Ops/Map.hs index 102437dc..89500cbf 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Map.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Map.hs @@ -249,11 +249,11 @@ izipWith4 f arr1 arr2 arr3 arr4 = -- | Similar to `zipWith`, except does it sequentially and using the `Applicative`. Note that --- resulting array has Mutable representation. +-- resulting array has Manifest representation. -- -- @since 0.3.0 zipWithA :: - (Source r1 e1, Source r2 e2, Applicative f, Mutable r e, Index ix) + (Source r1 e1, Source r2 e2, Applicative f, Manifest r e, Index ix) => (e1 -> e2 -> f e) -> Array r1 ix e1 -> Array r2 ix e2 @@ -262,11 +262,11 @@ zipWithA f = izipWithA (const f) {-# INLINE zipWithA #-} -- | Similar to `zipWith`, except does it sequentiall and using the `Applicative`. Note that --- resulting array has Mutable representation. +-- resulting array has Manifest representation. -- -- @since 0.3.0 izipWithA :: - (Source r1 e1, Source r2 e2, Applicative f, Mutable r e, Index ix) + (Source r1 e1, Source r2 e2, Applicative f, Manifest r e, Index ix) => (ix -> e1 -> e2 -> f e) -> Array r1 ix e1 -> Array r2 ix e2 @@ -282,7 +282,7 @@ izipWithA f arr1 arr2 = -- -- @since 0.3.0 zipWith3A :: - (Source r1 e1, Source r2 e2, Source r3 e3, Applicative f, Mutable r e, Index ix) + (Source r1 e1, Source r2 e2, Source r3 e3, Applicative f, Manifest r e, Index ix) => (e1 -> e2 -> e3 -> f e) -> Array r1 ix e1 -> Array r2 ix e2 @@ -295,7 +295,7 @@ zipWith3A f = izipWith3A (const f) -- -- @since 0.3.0 izipWith3A :: - (Source r1 e1, Source r2 e2, Source r3 e3, Applicative f, Mutable r e, Index ix) + (Source r1 e1, Source r2 e2, Source r3 e3, Applicative f, Manifest r e, Index ix) => (ix -> e1 -> e2 -> e3 -> f e) -> Array r1 ix e1 -> Array r2 ix e2 @@ -322,7 +322,7 @@ izipWith3A f arr1 arr2 arr3 = -- @since 0.2.6 -- traverseA :: - forall r ix e r' a f . (Source r' a, Mutable r e, Index ix, Applicative f) + forall r ix e r' a f . (Source r' a, Manifest r e, Index ix, Applicative f) => (a -> f e) -> Array r' ix a -> f (Array r ix e) @@ -346,7 +346,7 @@ traverseA_ f arr = loopA_ 0 (< totalElem (size arr)) (+ 1) (f . unsafeLinearInde -- @since 0.3.0 -- sequenceA :: - forall r ix e r' f. (Source r' (f e), Mutable r e, Index ix, Applicative f) + forall r ix e r' f. (Source r' (f e), Manifest r e, Index ix, Applicative f) => Array r' ix (f e) -> f (Array r ix e) sequenceA = traverseA id @@ -369,7 +369,7 @@ sequenceA_ = traverseA_ id -- @since 0.2.6 -- itraverseA :: - forall r ix e r' a f . (Source r' a, Mutable r e, Index ix, Applicative f) + forall r ix e r' a f . (Source r' a, Manifest r e, Index ix, Applicative f) => (ix -> a -> f e) -> Array r' ix a -> f (Array r ix e) @@ -399,7 +399,7 @@ itraverseA_ f arr = -- @since 0.3.0 -- traversePrim :: - forall r ix b r' a m . (Source r' a, Mutable r b, Index ix, PrimMonad m) + forall r ix b r' a m . (Source r' a, Manifest r b, Index ix, PrimMonad m) => (a -> m b) -> Array r' ix a -> m (Array r ix b) @@ -411,7 +411,7 @@ traversePrim f = itraversePrim (const f) -- @since 0.3.0 -- itraversePrim :: - forall r ix b r' a m . (Source r' a, Mutable r b, Index ix, PrimMonad m) + forall r ix b r' a m . (Source r' a, Manifest r b, Index ix, PrimMonad m) => (ix -> a -> m b) -> Array r' ix a -> m (Array r ix b) @@ -432,7 +432,7 @@ itraversePrim f arr = -- -- @since 0.2.6 mapM :: - forall r ix b r' a m. (Source r' a, Mutable r b, Index ix, Monad m) + forall r ix b r' a m. (Source r' a, Manifest r b, Index ix, Monad m) => (a -> m b) -- ^ Mapping action -> Array r' ix a -- ^ Source array -> m (Array r ix b) @@ -444,7 +444,7 @@ mapM = traverseA -- -- @since 0.2.6 forM :: - forall r ix b r' a m. (Source r' a, Mutable r b, Index ix, Monad m) + forall r ix b r' a m. (Source r' a, Manifest r b, Index ix, Monad m) => Array r' ix a -> (a -> m b) -> m (Array r ix b) @@ -456,7 +456,7 @@ forM = flip traverseA -- -- @since 0.2.6 imapM :: - forall r ix b r' a m. (Source r' a, Mutable r b, Index ix, Monad m) + forall r ix b r' a m. (Source r' a, Manifest r b, Index ix, Monad m) => (ix -> a -> m b) -> Array r' ix a -> m (Array r ix b) @@ -468,7 +468,7 @@ imapM = itraverseA -- -- @since 0.5.1 iforM :: - forall r ix b r' a m. (Source r' a, Mutable r b, Index ix, Monad m) + forall r ix b r' a m. (Source r' a, Manifest r b, Index ix, Monad m) => Array r' ix a -> (ix -> a -> m b) -> m (Array r ix b) @@ -525,7 +525,7 @@ iforM_ = flip imapM_ -- -- @since 0.2.6 mapIO :: - forall r ix b r' a m. (Size r', Load r' ix a, Mutable r b, MonadUnliftIO m) + forall r ix b r' a m. (Size r', Load r' ix a, Manifest r b, MonadUnliftIO m) => (a -> m b) -> Array r' ix a -> m (Array r ix b) @@ -572,7 +572,7 @@ imapIO_ action arr = -- -- @since 0.2.6 imapIO :: - forall r ix b r' a m. (Size r', Load r' ix a, Mutable r b, MonadUnliftIO m) + forall r ix b r' a m. (Size r', Load r' ix a, Manifest r b, MonadUnliftIO m) => (ix -> a -> m b) -> Array r' ix a -> m (Array r ix b) @@ -590,7 +590,7 @@ imapIO action arr = do -- -- @since 0.2.6 forIO :: - forall r ix b r' a m. (Size r', Load r' ix a, Mutable r b, MonadUnliftIO m) + forall r ix b r' a m. (Size r', Load r' ix a, Manifest r b, MonadUnliftIO m) => Array r' ix a -> (a -> m b) -> m (Array r ix b) @@ -605,7 +605,7 @@ forIO = flip mapIO -- -- @since 0.3.4 imapWS :: - forall r ix b r' a s m. (Source r' a, Mutable r b, Index ix, MonadUnliftIO m, PrimMonad m) + forall r ix b r' a s m. (Source r' a, Manifest r b, Index ix, MonadUnliftIO m, PrimMonad m) => WorkerStates s -> (ix -> a -> s -> m b) -> Array r' ix a @@ -617,7 +617,7 @@ imapWS states f arr = generateArrayWS states (size arr) (\ix s -> f ix (unsafeIn -- -- @since 0.3.4 mapWS :: - forall r ix b r' a s m. (Source r' a, Mutable r b, Index ix, MonadUnliftIO m, PrimMonad m) + forall r ix b r' a s m. (Source r' a, Manifest r b, Index ix, MonadUnliftIO m, PrimMonad m) => WorkerStates s -> (a -> s -> m b) -> Array r' ix a @@ -630,7 +630,7 @@ mapWS states f = imapWS states (\ _ -> f) -- -- @since 0.3.4 iforWS :: - forall r ix b r' a s m. (Source r' a, Mutable r b, Index ix, MonadUnliftIO m, PrimMonad m) + forall r ix b r' a s m. (Source r' a, Manifest r b, Index ix, MonadUnliftIO m, PrimMonad m) => WorkerStates s -> Array r' ix a -> (ix -> a -> s -> m b) @@ -642,7 +642,7 @@ iforWS states f arr = imapWS states arr f -- -- @since 0.3.4 forWS :: - forall r ix b r' a s m. (Source r' a, Mutable r b, Index ix, MonadUnliftIO m, PrimMonad m) + forall r ix b r' a s m. (Source r' a, Manifest r b, Index ix, MonadUnliftIO m, PrimMonad m) => WorkerStates s -> Array r' ix a -> (a -> s -> m b) @@ -675,7 +675,7 @@ forIO_ = flip mapIO_ -- -- @since 0.2.6 iforIO :: - forall r ix b r' a m. (Size r', Load r' ix a, Mutable r b, MonadUnliftIO m) + forall r ix b r' a m. (Size r', Load r' ix a, Manifest r b, MonadUnliftIO m) => Array r' ix a -> (ix -> a -> m b) -> m (Array r ix b) diff --git a/massiv/src/Data/Massiv/Array/Ops/Sort.hs b/massiv/src/Data/Massiv/Array/Ops/Sort.hs index 339960f1..4b384b04 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Sort.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Sort.hs @@ -46,7 +46,7 @@ import System.IO.Unsafe -- [ (1,1), (2,3), (3,1), (4,2), (5,1) ] -- -- @since 0.4.4 -tally :: (Mutable r e, Load r ix e, Ord e) => Array r ix e -> Vector DS (e, Int) +tally :: (Manifest r e, Load r ix e, Ord e) => Array r ix e -> Vector DS (e, Int) tally arr | isEmpty arr = setComp (getComp arr) empty | otherwise = scatMaybes $ sunfoldrN (liftSz2 (+) sz oneSz) count (0, 0, sorted ! 0) @@ -69,7 +69,7 @@ tally arr -- -- @since 1.0.0 unsafeUnstablePartitionRegionM :: - forall r e m. (Mutable r e, PrimMonad m) + forall r e m. (Manifest r e, PrimMonad m) => MVector (PrimState m) r e -> (e -> m Bool) -> Ix1 -- ^ Start index of the region @@ -106,7 +106,7 @@ unsafeUnstablePartitionRegionM marr f start end = fromLeft start (end + 1) -- -- @since 0.3.2 quicksort :: - (Mutable r e, Ord e) => Vector r e -> Vector r e + (Manifest r e, Ord e) => Vector r e -> Vector r e quicksort arr = unsafePerformIO $ withMArray_ arr quicksortM_ {-# INLINE quicksort #-} @@ -115,23 +115,23 @@ quicksort arr = unsafePerformIO $ withMArray_ arr quicksortM_ -- -- @since 0.6.1 quicksortByM :: - (Mutable r e, MonadUnliftIO m) => (e -> e -> m Ordering) -> Vector r e -> m (Vector r e) + (Manifest r e, MonadUnliftIO m) => (e -> e -> m Ordering) -> Vector r e -> m (Vector r e) quicksortByM f arr = withRunInIO $ \run -> withMArray_ arr (quicksortByM_ (\x y -> run (f x y))) {-# INLINE quicksortByM #-} -- | Same as `quicksortBy`, but instead of `Ord` constraint expects a custom `Ordering`. -- -- @since 0.6.1 -quicksortBy :: Mutable r e => (e -> e -> Ordering) -> Vector r e -> Vector r e +quicksortBy :: Manifest r e => (e -> e -> Ordering) -> Vector r e -> Vector r e quicksortBy f arr = unsafePerformIO $ withMArray_ arr (quicksortByM_ (\x y -> pure $ f x y)) {-# INLINE quicksortBy #-} --- | Mutable version of `quicksort` +-- | Manifest version of `quicksort` -- -- @since 0.3.2 quicksortM_ :: - (Ord e, Mutable r e, MonadPrimBase s m) + (Ord e, Manifest r e, MonadPrimBase s m) => Scheduler s () -> MVector s r e -> m () @@ -143,7 +143,7 @@ quicksortM_ = quicksortInternalM_ (\e1 e2 -> pure $ e1 < e2) (\e1 e2 -> pure $ e -- -- @since 0.6.1 quicksortByM_ :: - (Mutable r e, MonadPrimBase s m) + (Manifest r e, MonadPrimBase s m) => (e -> e -> m Ordering) -> Scheduler s () -> MVector s r e @@ -154,7 +154,7 @@ quicksortByM_ compareM = quicksortInternalM_ :: - (Mutable r e, MonadPrimBase s m) + (Manifest r e, MonadPrimBase s m) => (e -> e -> m Bool) -> (e -> e -> m Bool) -> Scheduler s () diff --git a/massiv/src/Data/Massiv/Array/Ops/Transform.hs b/massiv/src/Data/Massiv/Array/Ops/Transform.hs index f3a0ff84..7f81d578 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Transform.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Transform.hs @@ -395,7 +395,7 @@ reverse' dim = throwEither . reverseM dim -- @since 0.3.0 backpermuteM :: forall r ix e r' ix' m. - (Mutable r e, Index ix, Source r' e, Index ix', MonadUnliftIO m, PrimMonad m, MonadThrow m) + (Manifest r e, Index ix, Source r' e, Index ix', MonadUnliftIO m, PrimMonad m, MonadThrow m) => Sz ix -- ^ Size of the result array -> (ix -> ix') -- ^ A function that maps indices of the new array into the source one. -> Array r' ix' e -- ^ Source array. @@ -1052,7 +1052,7 @@ upsample !fillWith safeStride arr = -- @since 0.3.0 transformM :: forall r ix e r' ix' e' a m. - (Mutable r e, Index ix, Source r' e', Index ix', MonadUnliftIO m, PrimMonad m, MonadThrow m) + (Manifest r e, Index ix, Source r' e', Index ix', MonadUnliftIO m, PrimMonad m, MonadThrow m) => (Sz ix' -> m (Sz ix, a)) -> (a -> (ix' -> m e') -> ix -> m e) -> Array r' ix' e' @@ -1082,7 +1082,7 @@ transform' getSz get arr = makeArray (getComp arr) sz (get a (evaluate' arr)) -- -- @since 0.3.0 transform2M :: - ( Mutable r e + ( Manifest r e , Index ix , Source r1 e1 , Source r2 e2 diff --git a/massiv/src/Data/Massiv/Array/Unsafe.hs b/massiv/src/Data/Massiv/Array/Unsafe.hs index 522d48c1..68568e97 100644 --- a/massiv/src/Data/Massiv/Array/Unsafe.hs +++ b/massiv/src/Data/Massiv/Array/Unsafe.hs @@ -152,7 +152,7 @@ unsafeTransform2 getSz get arr1 arr2 = -- -- @since 0.5.7 unsafeLoadIntoS :: - forall r r' ix e m s. (Load r ix e, Mutable r' e, MonadPrim s m) + forall r r' ix e m s. (Load r ix e, Manifest r' e, MonadPrim s m) => MVector s r' e -> Array r ix e -> m (MArray s r' ix e) @@ -163,7 +163,7 @@ unsafeLoadIntoS marr arr = stToPrim $ unsafeLoadIntoS marr arr -- -- @since 0.5.7 unsafeLoadIntoM :: - forall r r' ix e m. (Load r ix e, Mutable r' e, MonadIO m) + forall r r' ix e m. (Load r ix e, Manifest r' e, MonadIO m) => MVector RealWorld r' e -> Array r ix e -> m (MArray RealWorld r' ix e) diff --git a/massiv/src/Data/Massiv/Core/Common.hs b/massiv/src/Data/Massiv/Core/Common.hs index e8962512..9dbc4629 100644 --- a/massiv/src/Data/Massiv/Core/Common.hs +++ b/massiv/src/Data/Massiv/Core/Common.hs @@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} +{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} @@ -17,8 +18,9 @@ module Data.Massiv.Core.Common ( Array , Vector - , MVector , Matrix + , MArray + , MVector , MMatrix , Elt , Steps(..) @@ -31,7 +33,7 @@ module Data.Massiv.Core.Common , Shape(..) , Resize(..) , Manifest(..) - , Mutable(..) + , Mutable , Comp(..) , Scheduler , numWorkers @@ -118,6 +120,8 @@ import Data.Vector.Fusion.Util -- element @e@, even if that element does not yet exist in memory and the array has to be -- computed in order to get the value of that element. Data is always arranged in a nested -- row-major fashion. Rank of an array is specified by @`Dimensions` ix@. +-- +-- @since 0.1.0 data family Array r ix e :: Type -- | Type synonym for a single dimension array, or simply a flat vector. @@ -125,18 +129,23 @@ data family Array r ix e :: Type -- @since 0.5.0 type Vector r e = Array r Ix1 e - --- | Type synonym for a single dimension mutable array, or simply a flat mutable vector. --- --- @since 0.5.0 -type MVector s r e = MArray s r Ix1 e - -- | Type synonym for a two-dimentsional array, or simply a matrix. -- -- @since 0.5.0 type Matrix r e = Array r Ix2 e +-- | Mutable version of a `Manifest` `Array`. The extra type argument @s@ is for +-- the state token used by `IO` and `ST`. +-- +-- @since 0.1.0 +data family MArray s r ix e :: Type + +-- | Type synonym for a single dimension mutable array, or simply a flat mutable vector. +-- +-- @since 0.5.0 +type MVector s r e = MArray s r Ix1 e + -- | Type synonym for a two-dimentsional mutable array, or simply a mutable matrix. -- -- @since 0.5.0 @@ -409,7 +418,7 @@ class (Strategy r, Shape r ix) => Load r ix e where -- -- @since 1.0.0 unsafeLoadIntoST :: - Mutable r' e + Manifest r' e => MVector s r' e -> Array r ix e -> ST s (MArray s r' ix e) @@ -422,7 +431,7 @@ class (Strategy r, Shape r ix) => Load r ix e where -- -- @since 1.0.0 unsafeLoadIntoIO :: - Mutable r' e + Manifest r' e => MVector RealWorld r' e -> Array r ix e -> IO (MArray RealWorld r' ix e) @@ -464,23 +473,25 @@ class (Size r, Load r ix e) => StrideLoad r ix e where -- class (Size r, StrideLoad r ix e) => StrideLoadP r ix e where -- -- unsafeLoadIntoWithStrideST :: -- TODO: this would remove Size constraint and allow DS and LN instances for vectors. - -- Mutable r' ix e + -- Manifest r' ix e -- => Array r ix e -- -> Stride ix -- ^ Stride to use -- -> MArray RealWorld r' ix e -- -> m (MArray RealWorld r' ix e) +-- | Starting with massiv-1.0 `Mutable` and `Manifest` are synonymous. However, +-- this type class synonym will be deprecated in the next major version. +type Mutable r e = Manifest r e -- | Manifest arrays are backed by actual memory and values are looked up versus --- computed as it is with delayed arrays. Because of this fact indexing functions --- @(`!`)@, @(`!?`)@, etc. are constrained to manifest arrays only. +-- computed as it is with delayed arrays. Because manifest arrays are located in +-- memory their contents can be mutated once thawed into `MArray`. The process +-- of changed a mutable `MArray` back into an immutable `Array` is called +-- freezing. class (Resize r, Source r e) => Manifest r e where unsafeLinearIndexM :: Index ix => Array r ix e -> Int -> e -class Manifest r e => Mutable r e where - data MArray s r ix e :: Type - -- | /O(1)/ - Get the size of a mutable array. -- -- @since 1.0.0 @@ -611,7 +622,7 @@ class Manifest r e => Mutable r e where unsafeDefaultLinearShrink :: - (Mutable r e, Index ix, PrimMonad m) + (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> Sz ix -> m (MArray (PrimState m) r ix e) @@ -637,7 +648,7 @@ withMassivScheduler_ comp f = -- | Read an array element -- -- @since 0.1.0 -unsafeRead :: (Mutable r e, Index ix, PrimMonad m) => +unsafeRead :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> m e unsafeRead marr = unsafeLinearRead marr . toLinearIndex (sizeOfMArray marr) {-# INLINE unsafeRead #-} @@ -645,7 +656,7 @@ unsafeRead marr = unsafeLinearRead marr . toLinearIndex (sizeOfMArray marr) -- | Write an element into array -- -- @since 0.1.0 -unsafeWrite :: (Mutable r e, Index ix, PrimMonad m) => +unsafeWrite :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> e -> m () unsafeWrite marr = unsafeLinearWrite marr . toLinearIndex (sizeOfMArray marr) {-# INLINE unsafeWrite #-} @@ -654,7 +665,7 @@ unsafeWrite marr = unsafeLinearWrite marr . toLinearIndex (sizeOfMArray marr) -- | Modify an element in the array with a monadic action. Returns the previous value. -- -- @since 0.4.0 -unsafeLinearModify :: (Mutable r e, Index ix, PrimMonad m) => +unsafeLinearModify :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (e -> m e) -> Int -> m e unsafeLinearModify !marr f !i = do v <- unsafeLinearRead marr i @@ -666,7 +677,7 @@ unsafeLinearModify !marr f !i = do -- | Modify an element in the array with a monadic action. Returns the previous value. -- -- @since 0.4.0 -unsafeModify :: (Mutable r e, Index ix, PrimMonad m) => +unsafeModify :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> (e -> m e) -> ix -> m e unsafeModify marr f ix = unsafeLinearModify marr f (toLinearIndex (sizeOfMArray marr) ix) {-# INLINE unsafeModify #-} @@ -675,7 +686,7 @@ unsafeModify marr f ix = unsafeLinearModify marr f (toLinearIndex (sizeOfMArray -- values. -- -- @since 0.4.0 -unsafeSwap :: (Mutable r e, Index ix, PrimMonad m) => +unsafeSwap :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> ix -> m (e, e) unsafeSwap !marr !ix1 !ix2 = unsafeLinearSwap marr (toLinearIndex sz ix1) (toLinearIndex sz ix2) where sz = sizeOfMArray marr @@ -686,7 +697,7 @@ unsafeSwap !marr !ix1 !ix2 = unsafeLinearSwap marr (toLinearIndex sz ix1) (toLin -- previous values. -- -- @since 0.4.0 -unsafeLinearSwap :: (Mutable r e, Index ix, PrimMonad m) => +unsafeLinearSwap :: (Manifest r e, Index ix, PrimMonad m) => MArray (PrimState m) r ix e -> Int -> Int -> m (e, e) unsafeLinearSwap !marr !i1 !i2 = do val1 <- unsafeLinearRead marr i1 diff --git a/massiv/src/Data/Massiv/Vector.hs b/massiv/src/Data/Massiv/Vector.hs index 3d931230..87266112 100644 --- a/massiv/src/Data/Massiv/Vector.hs +++ b/massiv/src/Data/Massiv/Vector.hs @@ -118,7 +118,7 @@ module Data.Massiv.Vector -- -- ** Permutations -- , reverse -- , backpermute - -- -- ** Mutable updates + -- -- ** Manifest updates -- , modify -- -- * Elementwise -- -- ** Mapping @@ -266,15 +266,6 @@ module Data.Massiv.Vector , convert , convertAs , convertProxy - -- -- ** Other vector types - -- , convert - -- -- ** Mutable vectors - -- , freeze - -- , thaw - -- , copy - -- , unsafeFreeze - -- , unsafeThaw - -- , unsafeCopy -- ** Re-exports , module Data.Massiv.Core , module Data.Massiv.Array.Delayed diff --git a/massiv/src/Data/Massiv/Vector/Stream.hs b/massiv/src/Data/Massiv/Vector/Stream.hs index 51575d08..c1debb6b 100644 --- a/massiv/src/Data/Massiv/Vector/Stream.hs +++ b/massiv/src/Data/Massiv/Vector/Stream.hs @@ -225,24 +225,24 @@ toBundle arr = in B.fromStream str (sizeHintToBundleSize k) {-# INLINE toBundle #-} -fromBundle :: Mutable r e => B.Bundle Id v e -> Vector r e +fromBundle :: Manifest r e => B.Bundle Id v e -> Vector r e fromBundle bundle = fromStream (B.sSize bundle) (B.sElems bundle) {-# INLINE fromBundle #-} -fromBundleM :: (Monad m, Mutable r e) => B.Bundle m v e -> m (Vector r e) +fromBundleM :: (Monad m, Manifest r e) => B.Bundle m v e -> m (Vector r e) fromBundleM bundle = fromStreamM (B.sSize bundle) (B.sElems bundle) {-# INLINE fromBundleM #-} -fromStream :: forall r e . Mutable r e => B.Size -> S.Stream Id e -> Vector r e +fromStream :: forall r e . Manifest r e => B.Size -> S.Stream Id e -> Vector r e fromStream sz str = case B.upperBound sz of Nothing -> unstreamUnknown str Just k -> unstreamMax k str {-# INLINE fromStream #-} -fromStreamM :: forall r e m. (Monad m, Mutable r e) => B.Size -> S.Stream m e -> m (Vector r e) +fromStreamM :: forall r e m. (Monad m, Manifest r e) => B.Size -> S.Stream m e -> m (Vector r e) fromStreamM sz str = do xs <- S.toList str case B.upperBound sz of @@ -251,7 +251,7 @@ fromStreamM sz str = do {-# INLINE fromStreamM #-} fromStreamExactM :: - forall r ix e m. (Monad m, Mutable r e, Index ix) + forall r ix e m. (Monad m, Manifest r e, Index ix) => Sz ix -> S.Stream m e -> m (Array r ix e) @@ -262,7 +262,7 @@ fromStreamExactM sz str = do unstreamIntoM :: - (Mutable r a, PrimMonad m) + (Manifest r a, PrimMonad m) => MVector (PrimState m) r a -> LengthHint -> S.Stream Id a @@ -277,7 +277,7 @@ unstreamIntoM marr sz str = unstreamMax :: - forall r e. (Mutable r e) + forall r e. (Manifest r e) => Int -> S.Stream Id e -> Vector r e @@ -290,7 +290,7 @@ unstreamMax kMax str = unstreamMaxM :: - (Mutable r a, Index ix, PrimMonad m) => MArray (PrimState m) r ix a -> S.Stream Id a -> m Int + (Manifest r a, Index ix, PrimMonad m) => MArray (PrimState m) r ix a -> S.Stream Id a -> m Int unstreamMaxM marr (S.Stream step s) = stepLoad s 0 where stepLoad t i = @@ -304,7 +304,7 @@ unstreamMaxM marr (S.Stream step s) = stepLoad s 0 {-# INLINE unstreamMaxM #-} -unstreamUnknown :: Mutable r a => S.Stream Id a -> Vector r a +unstreamUnknown :: Manifest r a => S.Stream Id a -> Vector r a unstreamUnknown str = runST $ do marr <- unsafeNew zeroSz @@ -313,7 +313,7 @@ unstreamUnknown str = unstreamUnknownM :: - (Mutable r a, PrimMonad m) + (Manifest r a, PrimMonad m) => MVector (PrimState m) r a -> S.Stream Id a -> m (MVector (PrimState m) r a) @@ -336,7 +336,7 @@ unstreamUnknownM marrInit (S.Stream step s) = stepLoad s 0 (unSz (sizeOfMArray m unstreamExact :: - forall r ix e. (Mutable r e, Index ix) + forall r ix e. (Manifest r e, Index ix) => Sz ix -> S.Stream Id e -> Array r ix e From baa8a3a1dc41a2aba750259955ec8455f80e93c9 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Mon, 26 Jul 2021 03:03:35 +0300 Subject: [PATCH 48/65] Reorder test running on CI and attempt to fix doctets --- .github/workflows/haskell.yml | 4 +++- massiv-test/tests/Test/Massiv/Array/Ops/MapSpec.hs | 6 +----- massiv/src/Data/Massiv/Array/Numeric.hs | 1 + 3 files changed, 5 insertions(+), 6 deletions(-) diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index 826bdf25..609fddc1 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -112,7 +112,9 @@ jobs: curl -L https://github.com/rubik/stack-hpc-coveralls/releases/download/v0.0.6.1/shc-linux-x64-8.8.4.tar.bz2 | tar xj shc ./shc --repo-token="$COVERALLS_TOKEN" --partial-coverage --fetch-coverage combined custom else - stack $STACK_ARGS test massiv-test:tests massiv:doctests --bench --no-run-benchmarks --haddock --no-haddock-deps + stack $STACK_ARGS test --no-run-tests --bench --no-run-benchmarks --haddock --no-haddock-deps + stack $STACK_ARGS test massiv-test:tests + stack $STACK_ARGS test massiv:doctests fi massiv-examples: diff --git a/massiv-test/tests/Test/Massiv/Array/Ops/MapSpec.hs b/massiv-test/tests/Test/Massiv/Array/Ops/MapSpec.hs index bd677234..a1417d44 100644 --- a/massiv-test/tests/Test/Massiv/Array/Ops/MapSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/Ops/MapSpec.hs @@ -141,7 +141,7 @@ spec = do 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) -alt_imapM f arr = fmap loadList $ P.traverse (uncurry f) $ foldrS (:) [] (zipWithIndex arr) +alt_imapM f arr = fmap loadList $ P.traverse (uncurry f) $ foldrS (:) [] (imap (,) arr) where loadList xs = runST $ do @@ -150,10 +150,6 @@ alt_imapM f arr = fmap loadList $ P.traverse (uncurry f) $ foldrS (:) [] (zipWit unsafeFreeze (getComp arr) marr {-# INLINE loadList #-} -zipWithIndex :: forall r ix e . (Index ix, Source r e) => Array r ix e -> Array D ix (ix, e) -zipWithIndex arr = A.zip (range Seq zeroIndex (unSz (size arr))) arr -{-# INLINE zipWithIndex #-} - prop_MapWS :: (Show (Array U ix Int), Index ix) => Array U ix Int -> Property prop_MapWS arr = diff --git a/massiv/src/Data/Massiv/Array/Numeric.hs b/massiv/src/Data/Massiv/Array/Numeric.hs index da02b4ac..055e4eb3 100644 --- a/massiv/src/Data/Massiv/Array/Numeric.hs +++ b/massiv/src/Data/Massiv/Array/Numeric.hs @@ -518,6 +518,7 @@ multiplyVectorByMatrix v mm -- -- ====__Examples__ -- +-- >>> import Data.Massiv.Array -- >>> a1 = makeArrayR P Seq (Sz2 5 6) $ \(i :. j) -> i + j -- >>> a2 = makeArrayR P Seq (Sz2 6 5) $ \(i :. j) -> i - j -- >>> a1 !> Date: Mon, 26 Jul 2021 03:42:38 +0300 Subject: [PATCH 49/65] Export Shape functions and LengthHint --- Quickref.md | 2 +- massiv/src/Data/Massiv/Array/Numeric/Integral.hs | 2 +- massiv/src/Data/Massiv/Core.hs | 3 ++- massiv/src/Data/Massiv/Core/Common.hs | 3 --- 4 files changed, 4 insertions(+), 6 deletions(-) diff --git a/Quickref.md b/Quickref.md index 6f793850..4ee74f78 100644 --- a/Quickref.md +++ b/Quickref.md @@ -33,7 +33,7 @@ memory at some point. ### Class dependency ``` -Size (DL, D, DI, DW, B, BN, BL, P, U, S) -> Resize -> +Resize (DL, D, DI, B, BN, BL, P, U, S) -> Size (DW) Load (DL, DS, DI, DW, L, LN) -> Source (D) -> Mutable (B, BN, BL, P, U, S) |\ | `> StrideLoad (D, DI, DW, B, BN, BL, P, U, S) diff --git a/massiv/src/Data/Massiv/Array/Numeric/Integral.hs b/massiv/src/Data/Massiv/Array/Numeric/Integral.hs index 972fe9e1..f5b724b0 100644 --- a/massiv/src/Data/Massiv/Array/Numeric/Integral.hs +++ b/massiv/src/Data/Massiv/Array/Numeric/Integral.hs @@ -306,7 +306,7 @@ fromFunctionMidpoint comp f a d (Sz sz) n = -- The problem with above example is that computed values do not accurately represent the total -- value contained within each vector cell. For that reason if your were to later use it for example -- as convolution stencil, approximation would be very poor. The way to solve it is to approximate --- an integral across each cell of vector by drastically blowing up the `xArr` and then reducing it +-- an integral across each cell of vector by drastically blowing up the @xArr@ and then reducing it -- to a smaller array by using one of the approximation rules: -- -- >>> startValue = -2 :: Float diff --git a/massiv/src/Data/Massiv/Core.hs b/massiv/src/Data/Massiv/Core.hs index 7324e80a..d84a0aec 100644 --- a/massiv/src/Data/Massiv/Core.hs +++ b/massiv/src/Data/Massiv/Core.hs @@ -18,7 +18,8 @@ module Data.Massiv.Core , Source , Size , Resize - , Shape + , Shape(..) + , LengthHint(..) , StrideLoad(..) , Manifest , Mutable diff --git a/massiv/src/Data/Massiv/Core/Common.hs b/massiv/src/Data/Massiv/Core/Common.hs index 9dbc4629..e29d314d 100644 --- a/massiv/src/Data/Massiv/Core/Common.hs +++ b/massiv/src/Data/Massiv/Core/Common.hs @@ -1046,9 +1046,6 @@ isNotEmpty = not . isEmpty -- | /O(1)/ - Get the number of elements in the array. -- --- /Note/ - It is always a constant time operation except for some arrays with --- `Data.Massiv.Array.DS` representation. See `Data.Massiv.Vector.slength` for more info. --- -- ==== __Examples__ -- -- >>> import Data.Massiv.Array From e3f03e1045278ebf5a0b1fdcc7cba996bb910aab Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Mon, 26 Jul 2021 04:13:03 +0300 Subject: [PATCH 50/65] Get rid of Resize. Remove Size instance for DW --- massiv-test/src/Test/Massiv/Array/Delayed.hs | 3 +-- massiv-test/src/Test/Massiv/Array/Numeric.hs | 1 - .../tests/Test/Massiv/Array/MutableSpec.hs | 1 - .../tests/Test/Massiv/Array/Ops/TransformSpec.hs | 3 +-- massiv/CHANGELOG.md | 3 ++- .../src/Data/Massiv/Array/Delayed/Interleaved.hs | 2 -- massiv/src/Data/Massiv/Array/Delayed/Pull.hs | 2 -- massiv/src/Data/Massiv/Array/Delayed/Push.hs | 6 ++---- massiv/src/Data/Massiv/Array/Delayed/Windowed.hs | 13 ++++++------- massiv/src/Data/Massiv/Array/Manifest/Boxed.hs | 15 +++++---------- massiv/src/Data/Massiv/Array/Manifest/Internal.hs | 2 +- .../src/Data/Massiv/Array/Manifest/Primitive.hs | 2 -- massiv/src/Data/Massiv/Array/Manifest/Storable.hs | 2 -- massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs | 2 -- massiv/src/Data/Massiv/Array/Ops/Transform.hs | 10 +++++----- massiv/src/Data/Massiv/Core.hs | 1 - massiv/src/Data/Massiv/Core/Common.hs | 8 +++----- 17 files changed, 26 insertions(+), 50 deletions(-) diff --git a/massiv-test/src/Test/Massiv/Array/Delayed.hs b/massiv-test/src/Test/Massiv/Array/Delayed.hs index f9a4ff0e..5569941d 100644 --- a/massiv-test/src/Test/Massiv/Array/Delayed.hs +++ b/massiv-test/src/Test/Massiv/Array/Delayed.hs @@ -32,7 +32,7 @@ import Data.List as L -- | Alternative implementation of `stackSlicesM` with `concat'`. Useful for testing and benchmarks stackSlices' :: - (Functor f, Foldable f, Resize r, Source r e, Index ix, Load r (Lower ix) e) + (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,7 +40,6 @@ stackSlices' dim arrsF = 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 str ls = diff --git a/massiv-test/src/Test/Massiv/Array/Numeric.hs b/massiv-test/src/Test/Massiv/Array/Numeric.hs index 0a0dad7f..ca8ca9a9 100644 --- a/massiv-test/src/Test/Massiv/Array/Numeric.hs +++ b/massiv-test/src/Test/Massiv/Array/Numeric.hs @@ -74,7 +74,6 @@ prop_VectorMatrixMultiply :: forall r e. ( Numeric r e , Load r Ix1 e - , Source r e , Manifest r e , Show (Vector r e) , Eq (Vector r e) diff --git a/massiv-test/tests/Test/Massiv/Array/MutableSpec.hs b/massiv-test/tests/Test/Massiv/Array/MutableSpec.hs index 124586d8..295e0b75 100644 --- a/massiv-test/tests/Test/Massiv/Array/MutableSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/MutableSpec.hs @@ -29,7 +29,6 @@ type MutableArraySpec r ix e , Eq (Vector r e) , Show (Vector r e) , Load r ix e - , Resize r , Arbitrary (Array r ix e) , Manifest r e , Stream r ix e diff --git a/massiv-test/tests/Test/Massiv/Array/Ops/TransformSpec.hs b/massiv-test/tests/Test/Massiv/Array/Ops/TransformSpec.hs index f8f6b71c..c903ad30 100644 --- a/massiv-test/tests/Test/Massiv/Array/Ops/TransformSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/Ops/TransformSpec.hs @@ -100,7 +100,7 @@ prop_ConcatMconcat arrs = computeAs P (concat' 1 (A.empty : arrs)) === computeAs P (mconcat (fmap toLoadArray arrs)) prop_ExtractSizeMismatch :: - (Resize r, Load r ix e, NFData (Array r Int e)) => ArrTiny r ix e -> Positive Int -> Property + (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 where @@ -211,7 +211,6 @@ type Transform r ix e , Show (Array r ix Int) , NFData (Array r ix e) , NFData (Array r Int e) - , Resize r , Load r ix e , Load r ix Int , Ragged L ix e diff --git a/massiv/CHANGELOG.md b/massiv/CHANGELOG.md index 8d82d249..679c2996 100644 --- a/massiv/CHANGELOG.md +++ b/massiv/CHANGELOG.md @@ -13,11 +13,12 @@ * Get rid of `M` representation * Introduce `Shape`, the parent of `Size` * Move `size` from `Load` into new class `Size` +* Consolidate `Resize` into `Size` * Removed `maxSize` and replaced it with `maxLinearSize` * Remove specialized `DW` instances that used tuples as indices. * Remove `OuterSlice L` instance * Add `Strategy` and move `setComp` (from `Construct`) and `getComp` (from `Load`) in there. -* Remove `ix` from `Mutable`, `Manifest`, `Source` and `Resize` +* Remove `ix` from `Mutable`, `Manifest`, `Source` * Remove `liftArray2`. * Prevent `showsArrayPrec` from changing index type * Change function argument to monadic action for `unstablePartitionM` and `unsafeUnstablePartitionM` diff --git a/massiv/src/Data/Massiv/Array/Delayed/Interleaved.hs b/massiv/src/Data/Massiv/Array/Delayed/Interleaved.hs index 34c4ba09..c40bd4c7 100644 --- a/massiv/src/Data/Massiv/Array/Delayed/Interleaved.hs +++ b/massiv/src/Data/Massiv/Array/Delayed/Interleaved.hs @@ -50,8 +50,6 @@ instance Index ix => Shape DI ix where instance Size DI where size (DIArray arr) = size arr {-# INLINE size #-} - -instance Resize DI where unsafeResize sz = DIArray . unsafeResize sz . diArray {-# INLINE unsafeResize #-} diff --git a/massiv/src/Data/Massiv/Array/Delayed/Pull.hs b/massiv/src/Data/Massiv/Array/Delayed/Pull.hs index 460fb1e4..74fc5b5c 100644 --- a/massiv/src/Data/Massiv/Array/Delayed/Pull.hs +++ b/massiv/src/Data/Massiv/Array/Delayed/Pull.hs @@ -59,8 +59,6 @@ instance Index ix => Shape D ix where instance Size D where size = dSize {-# INLINE size #-} - -instance Resize D where unsafeResize !sz !arr = DArray (dComp arr) sz $ \ !ix -> unsafeIndex arr (fromLinearIndex (size arr) (toLinearIndex sz ix)) diff --git a/massiv/src/Data/Massiv/Array/Delayed/Push.hs b/massiv/src/Data/Massiv/Array/Delayed/Push.hs index d5db6a22..2ecfe397 100644 --- a/massiv/src/Data/Massiv/Array/Delayed/Push.hs +++ b/massiv/src/Data/Massiv/Array/Delayed/Push.hs @@ -71,9 +71,7 @@ instance Index ix => Shape DL ix where instance Size DL where size = dlSize {-# INLINE size #-} - -instance Resize DL where - unsafeResize !sz arr = arr { dlSize = sz } + unsafeResize !sz !arr = arr { dlSize = sz } {-# INLINE unsafeResize #-} instance Semigroup (Array DL Ix1 e) where @@ -306,7 +304,7 @@ fromStrideLoad :: fromStrideLoad stride arr = DLArray (getComp arr) newsz load where - !newsz = strideSize stride (size arr) + !newsz = strideSize stride (outerSize arr) load :: Loader e load scheduler !startAt dlWrite _ = iterArrayLinearWithStrideST_ scheduler stride newsz arr (\ !i -> dlWrite (i + startAt)) diff --git a/massiv/src/Data/Massiv/Array/Delayed/Windowed.hs b/massiv/src/Data/Massiv/Array/Delayed/Windowed.hs index cbc13b6f..36f04369 100644 --- a/massiv/src/Data/Massiv/Array/Delayed/Windowed.hs +++ b/massiv/src/Data/Massiv/Array/Delayed/Windowed.hs @@ -206,13 +206,12 @@ loadWithIx1 with (DWArray (DArray _ sz indexB) mWindow) uWrite = do {-# INLINE loadWithIx1 #-} instance Index ix => Shape DW ix where - maxLinearSize = Just . SafeSz . elemsCount + maxLinearSize = Just . linearSize {-# INLINE maxLinearSize #-} - - -instance Size DW where - size = dSize . dwArray - {-# INLINE size #-} + linearSize = SafeSz . totalElem . dSize . dwArray + {-# INLINE linearSize #-} + outerSize = dSize . dwArray + {-# INLINE outerSize #-} instance Load DW Ix1 e where makeArray c sz f = DWArray (makeArray c sz f) Nothing @@ -278,7 +277,7 @@ loadWithIx2 with arr uWrite = do let ib :. jb = (wm + it) :. (wn + jt) !blockHeight = maybe 1 (min 7 . max 1) mUnrollHeight stride = oneStride - !sz = strideSize stride $ size arr + !sz = strideSize stride $ outerSize arr writeB !ix = uWrite (toLinearIndex sz ix) (indexB ix) {-# INLINE writeB #-} writeW !ix = uWrite (toLinearIndex sz ix) (indexW ix) diff --git a/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs b/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs index 45dd1550..f53153b8 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs @@ -140,12 +140,6 @@ instance Source BL e where unsafeLinearSlice i k (BLArray c _ o a) = BLArray c k (o + i) a {-# INLINE unsafeLinearSlice #-} - -instance Resize BL where - unsafeResize !sz !arr = arr { blSize = sz } - {-# INLINE unsafeResize #-} - - instance Manifest BL e where unsafeLinearIndexM (BLArray _ _sz o a) i = @@ -190,6 +184,9 @@ instance Manifest BL e where instance Size BL where size = blSize {-# INLINE size #-} + unsafeResize !sz !arr = arr { blSize = sz } + {-# INLINE unsafeResize #-} + instance Index ix => Shape BL ix where maxLinearSize = Just . SafeSz . elemsCount @@ -316,9 +313,6 @@ instance Strategy B where {-# INLINE setComp #-} -instance Resize B where - unsafeResize sz = coerce (\arr -> arr { blSize = sz }) - instance Index ix => Shape B ix where maxLinearSize = Just . SafeSz . elemsCount {-# INLINE maxLinearSize #-} @@ -326,6 +320,8 @@ instance Index ix => Shape B ix where instance Size B where size = blSize . coerce {-# INLINE size #-} + unsafeResize sz = coerce (\arr -> arr { blSize = sz }) + {-# INLINE unsafeResize #-} instance Manifest B e where @@ -497,7 +493,6 @@ instance Size BN where size = blSize . coerce {-# INLINE size #-} -instance Resize BN where unsafeResize !sz = coerce . unsafeResize sz . coerce {-# INLINE unsafeResize #-} diff --git a/massiv/src/Data/Massiv/Array/Manifest/Internal.hs b/massiv/src/Data/Massiv/Array/Manifest/Internal.hs index c3029d65..ffdcf5c0 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Internal.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Internal.hs @@ -237,7 +237,7 @@ computeWithStride :: -> Array r ix e computeWithStride stride !arr = unsafePerformIO $ do - let !sz = strideSize stride (size arr) + let !sz = strideSize stride (outerSize arr) unsafeCreateArray_ (getComp arr) sz $ \scheduler marr -> stToIO $ iterArrayLinearWithStrideST_ scheduler stride sz arr (unsafeLinearWrite marr) {-# INLINE computeWithStride #-} diff --git a/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs b/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs index c6199931..a5f0927a 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs @@ -120,8 +120,6 @@ instance Index ix => Shape P ix where instance Size P where size = pSize {-# INLINE size #-} - -instance Resize P where unsafeResize !sz !arr = arr { pSize = sz } {-# INLINE unsafeResize #-} diff --git a/massiv/src/Data/Massiv/Array/Manifest/Storable.hs b/massiv/src/Data/Massiv/Array/Manifest/Storable.hs index 3116813f..00256186 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Storable.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Storable.hs @@ -132,8 +132,6 @@ instance Index ix => Shape S ix where instance Size S where size = sSize {-# INLINE size #-} - -instance Resize S where unsafeResize !sz !arr = arr { sSize = sz } {-# INLINE unsafeResize #-} diff --git a/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs b/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs index e1126e95..9f367591 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs @@ -99,8 +99,6 @@ instance Index ix => Shape U ix where instance Size U where size = uSize {-# INLINE size #-} - -instance Resize U where unsafeResize !sz !arr = arr { uSize = sz } {-# INLINE unsafeResize #-} diff --git a/massiv/src/Data/Massiv/Array/Ops/Transform.hs b/massiv/src/Data/Massiv/Array/Ops/Transform.hs index 7f81d578..fa3fa294 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Transform.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Transform.hs @@ -142,7 +142,7 @@ extractFromTo' sIx eIx = extract' sIx $ Sz (liftIndex2 (-) eIx sIx) -- -- @since 0.3.0 resizeM :: - forall r ix ix' e m. (MonadThrow m, Index ix', Index ix, Resize r) + forall r ix ix' e m. (MonadThrow m, Index ix', Index ix, Size r) => Sz ix' -> Array r ix e -> m (Array r ix' e) @@ -153,7 +153,7 @@ resizeM sz arr = guardNumberOfElements (size arr) sz >> pure (unsafeResize sz ar -- -- @since 0.1.0 resize' :: - forall r ix ix' e. (HasCallStack, Index ix', Index ix, Resize r) + forall r ix ix' e. (HasCallStack, Index ix', Index ix, Size r) => Sz ix' -> Array r ix e -> Array r ix' e @@ -163,7 +163,7 @@ resize' sz = throwEither . resizeM sz -- | /O(1)/ - Reduce a multi-dimensional array into a flat vector -- -- @since 0.3.1 -flatten :: forall r ix e. (Index ix, Resize r) => Array r ix e -> Vector r e +flatten :: forall r ix e. (Index ix, Size r) => Array r ix e -> Vector r e flatten arr = unsafeResize (SafeSz (totalElem (size arr))) arr {-# INLINE flatten #-} @@ -1020,7 +1020,7 @@ downsample stride arr = -- -- @since 0.3.0 upsample :: - forall r ix e. (Resize r, Load r ix e) + forall r ix e. Load r ix e => e -- ^ Element to use for filling the newly added cells -> Stride ix -- ^ Fill cells according to this stride -> Array r ix e -- ^ Array that will have cells added to @@ -1042,7 +1042,7 @@ upsample !fillWith safeStride arr = timesStride !ix = liftIndex2 (*) stride ix {-# INLINE timesStride #-} !stride = unStride safeStride - !sz = size arr + ~sz = outerSize arr -- intentionally lazy in case it is used with DS !newsz = SafeSz (timesStride $ unSz sz) {-# INLINE upsample #-} diff --git a/massiv/src/Data/Massiv/Core.hs b/massiv/src/Data/Massiv/Core.hs index d84a0aec..5fe6db61 100644 --- a/massiv/src/Data/Massiv/Core.hs +++ b/massiv/src/Data/Massiv/Core.hs @@ -17,7 +17,6 @@ module Data.Massiv.Core , Stream(..) , Source , Size - , Resize , Shape(..) , LengthHint(..) , StrideLoad(..) diff --git a/massiv/src/Data/Massiv/Core/Common.hs b/massiv/src/Data/Massiv/Core/Common.hs index e29d314d..5ef28074 100644 --- a/massiv/src/Data/Massiv/Core/Common.hs +++ b/massiv/src/Data/Massiv/Core/Common.hs @@ -31,7 +31,6 @@ module Data.Massiv.Core.Common , StrideLoad(..) , Size(..) , Shape(..) - , Resize(..) , Manifest(..) , Mutable , Comp(..) @@ -279,7 +278,6 @@ class Size r where -- @since 0.1.0 size :: Array r ix e -> Sz ix -class Size r => Resize r where -- | /O(1)/ - Change the size of an array. Total number of elements should be the same, but it is -- not validated. unsafeResize :: (Index ix, Index ix') => Sz ix' -> Array r ix e -> Array r ix' e @@ -287,7 +285,7 @@ class Size r => Resize r where -- | Arrays that can be used as source to practically any manipulation function. -class (Strategy r, Resize r) => Source r e where +class (Strategy r, Size r) => Source r e where {-# MINIMAL (unsafeIndex|unsafeLinearIndex), unsafeLinearSlice #-} -- | Lookup element in the array. No bounds check is performed and access of @@ -442,7 +440,7 @@ class (Strategy r, Shape r ix) => Load r ix e where {-# INLINE unsafeLoadIntoIO #-} -class (Size r, Load r ix e) => StrideLoad r ix e where +class Load r ix e => StrideLoad r ix e where -- | Load an array into memory with stride. Default implementation requires an instance of -- `Source`. iterArrayLinearWithStrideST_ @@ -488,7 +486,7 @@ type Mutable r e = Manifest r e -- memory their contents can be mutated once thawed into `MArray`. The process -- of changed a mutable `MArray` back into an immutable `Array` is called -- freezing. -class (Resize r, Source r e) => Manifest r e where +class Source r e => Manifest r e where unsafeLinearIndexM :: Index ix => Array r ix e -> Int -> e From 0bccaa525f6cda52cfe0a09c6ecc6a2e526d2760 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Tue, 27 Jul 2021 02:09:37 +0300 Subject: [PATCH 51/65] Fix `iterateUntil` and `iterateUntilM`. Add `flattenMArray` --- Quickref.md | 7 +- massiv/CHANGELOG.md | 7 +- .../Data/Massiv/Array/Manifest/Internal.hs | 126 +++++++++--------- massiv/src/Data/Massiv/Array/Mutable.hs | 10 ++ massiv/src/Data/Massiv/Array/Unsafe.hs | 28 +--- massiv/src/Data/Massiv/Core/Common.hs | 31 ++++- 6 files changed, 107 insertions(+), 102 deletions(-) diff --git a/Quickref.md b/Quickref.md index 4ee74f78..bdb0fdf5 100644 --- a/Quickref.md +++ b/Quickref.md @@ -33,10 +33,9 @@ memory at some point. ### Class dependency ``` -Resize (DL, D, DI, B, BN, BL, P, U, S) -> Size (DW) -Load (DL, DS, DI, DW, L, LN) -> Source (D) -> Mutable (B, BN, BL, P, U, S) - |\ - | `> StrideLoad (D, DI, DW, B, BN, BL, P, U, S) +Size (D, DL, DI, B, BN, BL, P, U, S) +Shape (D, DL, DS, DI, DW, B, BN, BL, P, U, S, L, LN) +StrideLoad (DI, DW) -> Load (DL, DS, L) -> Source (D) -> Manifest (B, BN, BL, P, U, S) |\ | `> Extract (D, DS, DI, B, BN, BL, P, U, S) |\ diff --git a/massiv/CHANGELOG.md b/massiv/CHANGELOG.md index 679c2996..8d6b597a 100644 --- a/massiv/CHANGELOG.md +++ b/massiv/CHANGELOG.md @@ -10,13 +10,14 @@ * Add `uniformArray` and `uniformRangeArray` * Replace `isNonEmpty` with `isNotZeroSz` and added `isZeroSz` * Consolidate `Construct` class into `Load` -* Get rid of `M` representation * Introduce `Shape`, the parent of `Size` * Move `size` from `Load` into new class `Size` * Consolidate `Resize` into `Size` * Removed `maxSize` and replaced it with `maxLinearSize` * Remove specialized `DW` instances that used tuples as indices. -* Remove `OuterSlice L` instance +* Get rid of `M` representation +* Remove `R` type family and `Slice`, `InnerSlice` and `Extract` classes in favor of `D`. +* Consolidate `OuterSlice` into `Source` * Add `Strategy` and move `setComp` (from `Construct`) and `getComp` (from `Load`) in there. * Remove `ix` from `Mutable`, `Manifest`, `Source` * Remove `liftArray2`. @@ -34,7 +35,7 @@ of `loadArrayM` and `loadArrayWithSetM`. * Add `iterArrayLinearWithStrideST_` to `LoadStride` class instead of `loadArrayWithStrideM`. * Add new mutable functions: - * `resizeMArrayM`, + * `resizeMArrayM` and `flattenMArray`, * `outerSliceMArrayM` and `outerSlicesMArray`, * `for2PrimM_` and `ifor2PrimM_`, * `zipSwapM_` diff --git a/massiv/src/Data/Massiv/Array/Manifest/Internal.hs b/massiv/src/Data/Massiv/Array/Manifest/Internal.hs index ffdcf5c0..85a56729 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Internal.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Internal.hs @@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MagicHash #-} +{-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} @@ -18,6 +19,7 @@ module Data.Massiv.Array.Manifest.Internal ( Manifest(..) , Array(..) + , flattenMArray , compute , computeS , computeP @@ -35,12 +37,16 @@ module Data.Massiv.Array.Manifest.Internal , gcastArr , fromRaggedArrayM , fromRaggedArray' + , unsafeLoadIntoS + , unsafeLoadIntoM , iterateUntil , iterateUntilM ) where import Control.Exception (try) +import Control.DeepSeq import Control.Monad.ST +import Control.Monad.Primitive import Control.Scheduler import Data.Massiv.Array.Delayed.Pull import Data.Massiv.Array.Mutable @@ -252,6 +258,30 @@ computeWithStrideAs _ = computeWithStride {-# INLINE computeWithStrideAs #-} +-- | Load into a supplied mutable vector sequentially. Returned array is not +-- necesserally the same vector as the one that was supplied. It will be the +-- same only if it had enough space to load all the elements in. +-- +-- @since 0.5.7 +unsafeLoadIntoS :: + forall r r' ix e m s. (Load r ix e, Manifest r' e, MonadPrim s m) + => MVector s r' e + -> Array r ix e + -> m (MArray s r' ix e) +unsafeLoadIntoS marr arr = stToPrim $ unsafeLoadIntoS marr arr +{-# INLINE unsafeLoadIntoS #-} + +-- | Same as `unsafeLoadIntoS`, but respecting computation strategy. +-- +-- @since 0.5.7 +unsafeLoadIntoM :: + forall r r' ix e m. (Load r ix e, Manifest r' e, MonadIO m) + => MVector RealWorld r' e + -> Array r ix e + -> m (MArray RealWorld r' ix e) +unsafeLoadIntoM marr arr = liftIO $ unsafeLoadIntoIO marr arr +{-# INLINE unsafeLoadIntoM #-} + -- | Efficiently iterate a function until a convergence condition is satisfied. If the -- size of array doesn't change between iterations then no more than two new arrays will be @@ -262,8 +292,8 @@ computeWithStrideAs _ = computeWithStride -- ====__Example__ -- -- >>> import Data.Massiv.Array --- >>> a = computeAs P $ makeLoadArrayS (Sz2 8 8) (0 :: Int) $ \ w -> () <$ w (0 :. 0) 1 --- >>> a +-- >>> let arr = computeAs P $ makeLoadArrayS (Sz2 8 8) (0 :: Int) $ \ w -> () <$ w (0 :. 0) 1 +-- >>> arr -- Array P Seq (Sz (8 :. 8)) -- [ [ 1, 0, 0, 0, 0, 0, 0, 0 ] -- , [ 0, 0, 0, 0, 0, 0, 0, 0 ] @@ -274,9 +304,9 @@ computeWithStrideAs _ = computeWithStride -- , [ 0, 0, 0, 0, 0, 0, 0, 0 ] -- , [ 0, 0, 0, 0, 0, 0, 0, 0 ] -- ] --- >>> nextPascalRow cur above = if cur == 0 then above else cur --- >>> pascal = makeStencil (Sz2 2 2) 1 $ \ get -> nextPascalRow (get (0 :. 0)) (get (-1 :. -1) + get (-1 :. 0)) --- >>> iterateUntil (\_ _ a -> (a ! (7 :. 7)) /= 0) (\ _ -> mapStencil (Fill 0) pascal) a +-- >>> let nextPascalRow cur above = if cur == 0 then above else cur +-- >>> let pascal = makeStencil (Sz2 2 2) 1 $ \ get -> nextPascalRow (get (0 :. 0)) (get (-1 :. -1) + get (-1 :. 0)) +-- >>> iterateUntil (\_ _ a -> (a ! (7 :. 7)) /= 0) (\ _ -> mapStencil (Fill 0) pascal) arr -- Array P Seq (Sz (8 :. 8)) -- [ [ 1, 0, 0, 0, 0, 0, 0, 0 ] -- , [ 1, 1, 0, 0, 0, 0, 0, 0 ] @@ -290,7 +320,7 @@ computeWithStrideAs _ = computeWithStride -- -- @since 0.3.6 iterateUntil :: - (Size r', Load r' ix e, Manifest r e) + (Load r' ix e, Manifest r e, NFData (Array r ix e)) => (Int -> Array r ix e -> Array r ix e -> Bool) -- ^ Convergence condition. Accepts current iteration counter, array at the previous -- state and at the current state. @@ -299,85 +329,59 @@ iterateUntil :: -- differ if necessary -> Array r ix e -- ^ Initial source array -> Array r ix e -iterateUntil convergence iteration initArr0 - | convergence 0 initArr0 initArr1 = initArr1 - | otherwise = - unsafePerformIO $ do - let loadArr = iteration 1 initArr1 - marr <- unsafeNew (size loadArr) - iterateLoop - (\n a comp marr' -> convergence n a <$> unsafeFreeze comp marr') - iteration - 1 - initArr1 - loadArr - (asArr initArr0 marr) - where - !initArr1 = compute $ iteration 0 initArr0 - asArr :: Array r ix e -> MArray s r ix e -> MArray s r ix e - asArr _ = id +iterateUntil convergence iteration initArr0 = unsafePerformIO $ do + let loadArr0 = iteration 0 initArr0 + initMVec1 <- unsafeNew (fromMaybe zeroSz (maxLinearSize loadArr0)) + let conv n arr comp marr' = do + arr' <- unsafeFreeze comp marr' + arr' `deepseq` pure (convergence n arr arr', arr') + iterateLoop conv (\n -> pure . iteration n) 0 initArr0 loadArr0 initMVec1 {-# INLINE iterateUntil #-} --- | Monadic version of `iterateUntil` where at each iteration mutable version of an array --- is available. +-- | Monadic version of `iterateUntil` where at each iteration mutable version +-- of an array is available. However it is less efficient then the pure +-- alternative, because an intermediate array must be copied at each +-- iteration. -- -- @since 0.3.6 iterateUntilM :: - (Size r', Load r' ix e, Manifest r e, PrimMonad m, MonadIO m, PrimState m ~ RealWorld) - => (Int -> Array r ix e -> MArray (PrimState m) r ix e -> m Bool) + (Load r' ix e, Manifest r e, MonadIO m) + => (Int -> Array r ix e -> MArray RealWorld r ix e -> m Bool) -- ^ Convergence condition. Accepts current iteration counter, pure array at previous -- state and a mutable at the current state, therefore after each iteration its contents -- can be modifed if necessary. - -> (Int -> Array r ix e -> Array r' ix e) + -> (Int -> Array r ix e -> m (Array r' ix e)) -- ^ A modifying function to apply at each iteration. The size of resulting array may -- differ if necessary. -> Array r ix e -- ^ Initial source array -> m (Array r ix e) iterateUntilM convergence iteration initArr0 = do - let loadArr0 = iteration 0 initArr0 - initMArr1 <- unsafeNew (size loadArr0) - computeInto initMArr1 loadArr0 - shouldStop <- convergence 0 initArr0 initMArr1 - initArr1 <- unsafeFreeze (getComp loadArr0) initMArr1 - if shouldStop - then pure initArr1 - else do - let loadArr1 = iteration 1 initArr1 - marr <- unsafeNew (size loadArr1) - iterateLoop (\n a _ -> convergence n a) iteration 1 initArr1 loadArr1 marr + loadArr0 <- iteration 0 initArr0 + initMVec1 <- liftIO $ unsafeNew (fromMaybe zeroSz (maxLinearSize loadArr0)) + let conv n arr comp marr = (,) <$> convergence n arr marr <*> freeze comp marr + iterateLoop conv iteration 0 initArr0 loadArr0 initMVec1 {-# INLINE iterateUntilM #-} iterateLoop :: - (Size r', Load r' ix e, Manifest r e, PrimMonad m, MonadIO m, PrimState m ~ RealWorld) - => (Int -> Array r ix e -> Comp -> MArray (PrimState m) r ix e -> m Bool) - -> (Int -> Array r ix e -> Array r' ix e) + (Load r' ix e, Manifest r e, MonadIO m) + => (Int -> Array r ix e -> Comp -> MArray RealWorld r ix e -> m (Bool, Array r ix e)) + -> (Int -> Array r ix e -> m (Array r' ix e)) -> Int -> Array r ix e -> Array r' ix e - -> MArray (PrimState m) r ix e + -> MVector RealWorld r e -> m (Array r ix e) iterateLoop convergence iteration = go where - go !n !arr !loadArr !marr = do - let !sz = size loadArr - !k = totalElem sz - !mk = totalElem (sizeOfMArray marr) - !comp = getComp loadArr - marr' <- - if k == mk - then pure marr - else if k < mk - then unsafeLinearShrink marr sz - else unsafeLinearGrow marr sz - computeInto marr' loadArr - shouldStop <- convergence n arr comp marr' - arr' <- unsafeFreeze comp marr' + go n !arr !loadArr !mvec = do + let !comp = getComp loadArr + marr' <- unsafeLoadIntoM mvec loadArr + (shouldStop, arr') <- convergence n arr comp marr' if shouldStop then pure arr' else do - nextMArr <- unsafeThaw arr - go (n + 1) arr' (iteration (n + 1) arr') nextMArr + nextMArr <- liftIO $ unsafeThaw arr + arr'' <- iteration (n + 1) arr' + go (n + 1) arr' arr'' $ flattenMArray nextMArr {-# INLINE iterateLoop #-} - - diff --git a/massiv/src/Data/Massiv/Array/Mutable.hs b/massiv/src/Data/Massiv/Array/Mutable.hs index 4e8d5291..30a02cae 100644 --- a/massiv/src/Data/Massiv/Array/Mutable.hs +++ b/massiv/src/Data/Massiv/Array/Mutable.hs @@ -18,6 +18,7 @@ module Data.Massiv.Array.Mutable sizeOfMArray , msize , resizeMArrayM + , flattenMArray , outerSliceMArrayM , outerSlicesMArray -- ** Element-wise mutation @@ -129,6 +130,15 @@ resizeMArrayM :: -> m (MArray s r ix' e) resizeMArrayM sz marr = unsafeResizeMArray sz marr <$ guardNumberOfElements (sizeOfMArray marr) sz +{-# INLINE resizeMArrayM #-} + + +-- | /O(1)/ - Change a mutable array to a mutable vector. +-- +-- @since 1.0.0 +flattenMArray :: (Manifest r e, Index ix) => MArray s r ix e -> MVector s r e +flattenMArray marr = unsafeResizeMArray (toLinearSz (sizeOfMArray marr)) marr +{-# INLINE flattenMArray #-} -- | /O(1)/ - Slice a mutable array from the outside, while reducing its diff --git a/massiv/src/Data/Massiv/Array/Unsafe.hs b/massiv/src/Data/Massiv/Array/Unsafe.hs index 68568e97..467b4028 100644 --- a/massiv/src/Data/Massiv/Array/Unsafe.hs +++ b/massiv/src/Data/Massiv/Array/Unsafe.hs @@ -3,7 +3,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE MonoLocalBinds #-} -- | -- Module : Data.Massiv.Array.Unsafe -- Copyright : (c) Alexey Kuleshevich 2018-2021 @@ -93,12 +92,12 @@ module Data.Massiv.Array.Unsafe , module Data.Massiv.Array.Stencil.Unsafe ) where -import Control.Monad.Primitive import Data.Massiv.Array.Delayed.Pull (D, unsafeExtract, unsafeSlice, unsafeInnerSlice) import Data.Massiv.Array.Delayed.Push (unsafeMakeLoadArray, unsafeMakeLoadArrayAdjusted) import Data.Massiv.Array.Manifest.Boxed import Data.Massiv.Array.Manifest.Primitive import Data.Massiv.Array.Manifest.Storable +import Data.Massiv.Array.Manifest.Internal import Data.Massiv.Array.Mutable.Internal import Data.Massiv.Array.Ops.Sort (unsafeUnstablePartitionRegionM) import Data.Massiv.Core.Common @@ -144,28 +143,3 @@ unsafeTransform2 getSz get arr1 arr2 = where (sz, a) = getSz (size arr1) (size arr2) {-# INLINE unsafeTransform2 #-} - - - --- | Load into a supplied mutable array sequentially. Returned array does not have to be --- the same --- --- @since 0.5.7 -unsafeLoadIntoS :: - forall r r' ix e m s. (Load r ix e, Manifest r' e, MonadPrim s m) - => MVector s r' e - -> Array r ix e - -> m (MArray s r' ix e) -unsafeLoadIntoS marr arr = stToPrim $ unsafeLoadIntoS marr arr -{-# INLINE unsafeLoadIntoS #-} - --- | Same as `unsafeLoadIntoS`, but respecting computation strategy. --- --- @since 0.5.7 -unsafeLoadIntoM :: - forall r r' ix e m. (Load r ix e, Manifest r' e, MonadIO m) - => MVector RealWorld r' e - -> Array r ix e - -> m (MArray RealWorld r' ix e) -unsafeLoadIntoM marr arr = liftIO $ unsafeLoadIntoIO marr arr -{-# INLINE unsafeLoadIntoM #-} diff --git a/massiv/src/Data/Massiv/Core/Common.hs b/massiv/src/Data/Massiv/Core/Common.hs index 5ef28074..e2de0784 100644 --- a/massiv/src/Data/Massiv/Core/Common.hs +++ b/massiv/src/Data/Massiv/Core/Common.hs @@ -420,9 +420,11 @@ class (Strategy r, Shape r ix) => Load r ix e where => MVector s r' e -> Array r ix e -> ST s (MArray s r' ix e) - unsafeLoadIntoST marr arr = - unsafeResizeMArray (outerSize arr) marr <$ - iterArrayLinearWithSetST_ trivialScheduler_ arr (unsafeLinearWrite marr) (unsafeLinearSet marr) + unsafeLoadIntoST mvec arr = do + let sz = outerSize arr + mvec' <- resizeMVector mvec $ toLinearSz sz + iterArrayLinearWithSetST_ trivialScheduler_ arr (unsafeLinearWrite mvec') (unsafeLinearSet mvec') + pure $ unsafeResizeMArray sz mvec' {-# INLINE unsafeLoadIntoST #-} -- | Same as `unsafeLoadIntoST`, but respecting computation strategy. @@ -433,12 +435,27 @@ class (Strategy r, Shape r ix) => Load r ix e where => MVector RealWorld r' e -> Array r ix e -> IO (MArray RealWorld r' ix e) - unsafeLoadIntoIO marr arr = do - withMassivScheduler_ (getComp arr) $ \scheduler -> - stToIO $ iterArrayLinearWithSetST_ scheduler arr (unsafeLinearWrite marr) (unsafeLinearSet marr) - pure $ unsafeResizeMArray (outerSize arr) marr + unsafeLoadIntoIO mvec arr = do + let sz = outerSize arr + mvec' <- resizeMVector mvec $ toLinearSz sz + withMassivScheduler_ (getComp arr) $ \scheduler -> stToIO $ + iterArrayLinearWithSetST_ scheduler arr (unsafeLinearWrite mvec') (unsafeLinearSet mvec') + pure $ unsafeResizeMArray sz mvec' {-# INLINE unsafeLoadIntoIO #-} +resizeMVector :: + (Manifest r e, PrimMonad f) + => MVector (PrimState f) r e + -> Sz1 + -> f (MVector (PrimState f) r e) +resizeMVector mvec k = + let mk = sizeOfMArray mvec + in if k == mk + then pure mvec + else if k < mk + then unsafeLinearShrink mvec k + else unsafeLinearGrow mvec k +{-# INLINE resizeMVector #-} class Load r ix e => StrideLoad r ix e where -- | Load an array into memory with stride. Default implementation requires an instance of From ac9aa463aee478ccfa4ee8b03323237cc734a42d Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Tue, 27 Jul 2021 03:04:30 +0300 Subject: [PATCH 52/65] Fix benchmark compilation --- massiv-bench/bench/Concat.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/massiv-bench/bench/Concat.hs b/massiv-bench/bench/Concat.hs index eefbae77..ae539f1a 100644 --- a/massiv-bench/bench/Concat.hs +++ b/massiv-bench/bench/Concat.hs @@ -63,7 +63,7 @@ concatMutableM arrsF = unsafeCreateArray_ (foldMap getComp arrsF) newSz $ \scheduler marr -> do let arrayLoader !offset arr = do scheduleWork scheduler $ do - stToIO $ iterArrayLinearST scheduler arr (\i -> unsafeLinearWrite marr (i + offset)) + stToIO $ iterArrayLinearST_ scheduler arr (\i -> unsafeLinearWrite marr (i + offset)) pure (offset + totalElem (size arr)) foldM_ arrayLoader 0 $ a : arrs {-# INLINE concatMutableM #-} From a4e1cc82cc91f06a94354e236d50c71bcba389ff Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Tue, 27 Jul 2021 03:37:35 +0300 Subject: [PATCH 53/65] Remove comment and identify Stencil regression --- massiv-bench/bench/Stencil.hs | 8 ++++---- massiv/src/Data/Massiv/Array/Delayed/Stream.hs | 3 --- 2 files changed, 4 insertions(+), 7 deletions(-) diff --git a/massiv-bench/bench/Stencil.hs b/massiv-bench/bench/Stencil.hs index 5f41ae01..6463bde1 100644 --- a/massiv-bench/bench/Stencil.hs +++ b/massiv-bench/bench/Stencil.hs @@ -44,8 +44,8 @@ main = do "Average Seq" [ bench "Stencil" $ whnf (computeAs P . A.mapStencil (Fill 0) avg3x3StencilUnsafe) arr - , bench "Stencil (safe)" $ whnf (computeAs P . A.mapStencil (Fill 0) avg3x3Stencil) arr - , bench "Convolve Array Ix2" $ + , bench "* Stencil (safe)" $ whnf (computeAs P . A.mapStencil (Fill 0) avg3x3Stencil) arr + , bench "* Convolve Array Ix2" $ whnf (computeAs P . A.mapStencil (Fill 0) (sum3x3StencilConv / 9)) arr , bench "Convolve Kernel Array Ix2" $ whnf (computeAs P . A.mapStencil (Fill 0) (sum3x3StencilConvKern / 9)) arr @@ -59,9 +59,9 @@ main = do "Average Par" [ bench "Stencil" $ whnf (computeAs P . A.mapStencil (Fill 0) avg3x3StencilUnsafe) arr - , bench "Stencil (safe)" $ + , bench "* Stencil (safe)" $ whnf (computeAs P . A.mapStencil (Fill 0) avg3x3Stencil) arr - , bench "Convolve Array Ix2" $ + , bench "* Convolve Array Ix2" $ whnf (computeAs P . A.mapStencil (Fill 0) (sum3x3StencilConv / 9)) arr , bench "Monoid Array Ix2" $ whnf (computeAs P . A.mapStencil (Fill 0) (avgStencil (Sz 3))) arr diff --git a/massiv/src/Data/Massiv/Array/Delayed/Stream.hs b/massiv/src/Data/Massiv/Array/Delayed/Stream.hs index 76222ad6..8f1a247f 100644 --- a/massiv/src/Data/Massiv/Array/Delayed/Stream.hs +++ b/massiv/src/Data/Massiv/Array/Delayed/Stream.hs @@ -193,9 +193,6 @@ instance Load DS Ix1 e where {-# INLINE replicate #-} iterArrayLinearST_ _scheduler arr uWrite = - -- case stepsSize (dsArray arr) of - -- LengthExact _ -> - -- void $ S.foldlM (\i e -> uWrite i e >> pure (i + 1)) 0 (S.transStepsId (coerce arr)) S.mapM_ (uncurry uWrite) $ S.indexed $ S.transStepsId (coerce arr) {-# INLINE iterArrayLinearST_ #-} From b0ab8efd1ce9b71611626b7b17c79f5c97547799 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Tue, 27 Jul 2021 15:17:23 +0300 Subject: [PATCH 54/65] Fix regression in index function --- massiv-bench/bench/Stencil.hs | 8 ++++---- massiv/src/Data/Massiv/Core/Common.hs | 13 +++++-------- 2 files changed, 9 insertions(+), 12 deletions(-) diff --git a/massiv-bench/bench/Stencil.hs b/massiv-bench/bench/Stencil.hs index 6463bde1..5f41ae01 100644 --- a/massiv-bench/bench/Stencil.hs +++ b/massiv-bench/bench/Stencil.hs @@ -44,8 +44,8 @@ main = do "Average Seq" [ bench "Stencil" $ whnf (computeAs P . A.mapStencil (Fill 0) avg3x3StencilUnsafe) arr - , bench "* Stencil (safe)" $ whnf (computeAs P . A.mapStencil (Fill 0) avg3x3Stencil) arr - , bench "* Convolve Array Ix2" $ + , bench "Stencil (safe)" $ whnf (computeAs P . A.mapStencil (Fill 0) avg3x3Stencil) arr + , bench "Convolve Array Ix2" $ whnf (computeAs P . A.mapStencil (Fill 0) (sum3x3StencilConv / 9)) arr , bench "Convolve Kernel Array Ix2" $ whnf (computeAs P . A.mapStencil (Fill 0) (sum3x3StencilConvKern / 9)) arr @@ -59,9 +59,9 @@ main = do "Average Par" [ bench "Stencil" $ whnf (computeAs P . A.mapStencil (Fill 0) avg3x3StencilUnsafe) arr - , bench "* Stencil (safe)" $ + , bench "Stencil (safe)" $ whnf (computeAs P . A.mapStencil (Fill 0) avg3x3Stencil) arr - , bench "* Convolve Array Ix2" $ + , bench "Convolve Array Ix2" $ whnf (computeAs P . A.mapStencil (Fill 0) (sum3x3StencilConv / 9)) arr , bench "Monoid Array Ix2" $ whnf (computeAs P . A.mapStencil (Fill 0) (avgStencil (Sz 3))) arr diff --git a/massiv/src/Data/Massiv/Core/Common.hs b/massiv/src/Data/Massiv/Core/Common.hs index e2de0784..ab82f496 100644 --- a/massiv/src/Data/Massiv/Core/Common.hs +++ b/massiv/src/Data/Massiv/Core/Common.hs @@ -949,7 +949,7 @@ borderIndex border arr = handleBorderIndex border (size arr) (unsafeIndex arr) -- -- @since 0.1.0 index' :: (HasCallStack, Index ix, Manifest r e) => Array r ix e -> ix -> e -index' arr = throwEither . evaluateM arr +index' arr ix = throwEither (evaluateM arr ix) {-# INLINE index' #-} -- | This is just like `indexM` function, but it allows getting values from @@ -968,12 +968,9 @@ index' arr = throwEither . evaluateM arr -- -- @since 0.3.0 evaluateM :: (Index ix, Source r e, MonadThrow m) => Array r ix e -> ix -> m e -evaluateM arr ix = - handleBorderIndex - (Fill (throwM (IndexOutOfBoundsException (size arr) ix))) - (size arr) - (pure . unsafeIndex arr) - ix +evaluateM arr ix + | isSafeIndex (size arr) ix = pure (unsafeIndex arr ix) + | otherwise = throwM (IndexOutOfBoundsException (size arr) ix) {-# INLINE evaluateM #-} -- | Similar to `evaluateM`, but will throw an error on out of bounds indices. @@ -986,7 +983,7 @@ evaluateM arr ix = -- -- @since 0.3.0 evaluate' :: (HasCallStack, Index ix, Source r e) => Array r ix e -> ix -> e -evaluate' arr = throwEither . evaluateM arr +evaluate' arr ix = throwEither (evaluateM arr ix) {-# INLINE evaluate' #-} From 0f8d391859e436e2e593bd6b4f99b3942abd1e03 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Wed, 28 Jul 2021 16:32:23 +0300 Subject: [PATCH 55/65] Update scheduler dep in stack.yaml --- .github/ISSUE_TEMPLATE/feature_request.md | 2 +- .github/PULL_REQUEST_TEMPLATE.md | 2 +- massiv-bench/stack-ghc-8.0.yaml | 2 +- massiv-bench/stack-ghc-8.2.yaml | 2 +- massiv-bench/stack-ghc-8.6.yaml | 6 +----- massiv-bench/stack-ghc-8.8.yaml | 6 +----- massiv-bench/stack-ghc-9.0.yaml | 5 +---- massiv/src/Data/Massiv/Array/Ops/Construct.hs | 4 +++- massiv/src/Data/Massiv/Array/Ops/Transform.hs | 2 +- stack-extra-deps.yaml | 5 +---- stack.yaml | 5 +---- 11 files changed, 13 insertions(+), 28 deletions(-) diff --git a/.github/ISSUE_TEMPLATE/feature_request.md b/.github/ISSUE_TEMPLATE/feature_request.md index 49a47ea1..eef53b8b 100644 --- a/.github/ISSUE_TEMPLATE/feature_request.md +++ b/.github/ISSUE_TEMPLATE/feature_request.md @@ -1,6 +1,6 @@ --- name: Feature Request -about: Request a feature be added to massiv or massiv-io +about: Request a feature be added to massiv --- Make sure that you are using the latest release: https://hackage.haskell.org/package/massiv diff --git a/.github/PULL_REQUEST_TEMPLATE.md b/.github/PULL_REQUEST_TEMPLATE.md index c754c825..5ad7a761 100644 --- a/.github/PULL_REQUEST_TEMPLATE.md +++ b/.github/PULL_REQUEST_TEMPLATE.md @@ -1,4 +1,4 @@ -Please include this checklist whenever changes are introduced to either `massiv` or `massiv-io` packages: +Please include this checklist whenever changes are introduced to either `massiv` or `massiv-test` packages: * [ ] Bump up the version in cabal file * [ ] Any changes that could be relevant to users have been recorded in the `CHANGELOG.md` diff --git a/massiv-bench/stack-ghc-8.0.yaml b/massiv-bench/stack-ghc-8.0.yaml index 4907ddc3..8a38978a 100644 --- a/massiv-bench/stack-ghc-8.0.yaml +++ b/massiv-bench/stack-ghc-8.0.yaml @@ -3,7 +3,7 @@ packages: - '.' extra-deps: - '../massiv/' -- scheduler-1.4.0@sha256:b182be9a7b84e1dba02dac761c3f4e204521d0f779d72d86040789d5aaadf92a,2833 +- scheduler-2.0.0@sha256:3f053e3ff024fdcdd0983fb901313ef979921bc27e12dec97cd330878ddf78b1,2525 - unliftio-core-0.1.2.0@sha256:49d43dc863d14d89d91a676a968cea8d9f0030ad6ac95768747a44d0d273dd68 - cabal-doctest-1.0.6@sha256:c0b4a5b1ff38d2867e7003b4be59f3bd7e8e204ab8c988d96d3a77472ae671cd - doctest-0.16.0.1@sha256:0c8d44a0a781a6c277260788d9c1929f853cf2cb7d2ca36691222d01ddac1934 diff --git a/massiv-bench/stack-ghc-8.2.yaml b/massiv-bench/stack-ghc-8.2.yaml index fb086e4e..d1b2b673 100644 --- a/massiv-bench/stack-ghc-8.2.yaml +++ b/massiv-bench/stack-ghc-8.2.yaml @@ -3,7 +3,7 @@ packages: - '.' extra-deps: - '../massiv/' -- scheduler-1.4.0@sha256:b182be9a7b84e1dba02dac761c3f4e204521d0f779d72d86040789d5aaadf92a,2833 +- scheduler-2.0.0@sha256:3f053e3ff024fdcdd0983fb901313ef979921bc27e12dec97cd330878ddf78b1,2525 - github: lehins/dh-core commit: a24cd447718a23c9bb5732df5cfcc65bb91e5f2d subdirs: diff --git a/massiv-bench/stack-ghc-8.6.yaml b/massiv-bench/stack-ghc-8.6.yaml index 51d18815..06a813ff 100644 --- a/massiv-bench/stack-ghc-8.6.yaml +++ b/massiv-bench/stack-ghc-8.6.yaml @@ -3,13 +3,9 @@ packages: - '.' extra-deps: - '../massiv/' -#- scheduler-1.4.0@sha256:b182be9a7b84e1dba02dac761c3f4e204521d0f779d72d86040789d5aaadf92a,2833 +- scheduler-2.0.0@sha256:3f053e3ff024fdcdd0983fb901313ef979921bc27e12dec97cd330878ddf78b1,2525 - github: lehins/dh-core commit: a24cd447718a23c9bb5732df5cfcc65bb91e5f2d subdirs: - dense-linear-algebra -- github: lehins/haskell-scheduler - commit: c5506d20d96fc3fb00c213791243b7246d39e822 - subdirs: - - scheduler allow-newer: true diff --git a/massiv-bench/stack-ghc-8.8.yaml b/massiv-bench/stack-ghc-8.8.yaml index c92a185e..c553d209 100644 --- a/massiv-bench/stack-ghc-8.8.yaml +++ b/massiv-bench/stack-ghc-8.8.yaml @@ -6,8 +6,4 @@ extra-deps: - primitive-0.7.1.0@sha256:29de6bfd0cf8ba023ceb806203dfbec0e51e3524e75ffe41056f70b4229c6f0f,2728 - random-1.2.0@sha256:195506fedaa7c31c1fa2a747e9b49b4a5d1f0b09dd8f1291f23a771656faeec3,6097 - splitmix-0.1.0.3@sha256:fc3aae74c467f4b608050bef53aec17904a618731df9407e655d8f3bf8c32d5c,6049 -#- scheduler-1.4.0@sha256:b182be9a7b84e1dba02dac761c3f4e204521d0f779d72d86040789d5aaadf92a,2833 -- github: lehins/haskell-scheduler - commit: c5506d20d96fc3fb00c213791243b7246d39e822 - subdirs: - - scheduler +- scheduler-2.0.0@sha256:3f053e3ff024fdcdd0983fb901313ef979921bc27e12dec97cd330878ddf78b1,2525 diff --git a/massiv-bench/stack-ghc-9.0.yaml b/massiv-bench/stack-ghc-9.0.yaml index 3463a5dc..98574777 100644 --- a/massiv-bench/stack-ghc-9.0.yaml +++ b/massiv-bench/stack-ghc-9.0.yaml @@ -3,7 +3,4 @@ packages: - '.' extra-deps: - '../massiv/' -- github: lehins/haskell-scheduler - commit: c5506d20d96fc3fb00c213791243b7246d39e822 - subdirs: - - scheduler +- scheduler-2.0.0@sha256:3f053e3ff024fdcdd0983fb901313ef979921bc27e12dec97cd330878ddf78b1,2525 diff --git a/massiv/src/Data/Massiv/Array/Ops/Construct.hs b/massiv/src/Data/Massiv/Array/Ops/Construct.hs index 9285e413..e15be07a 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Construct.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Construct.hs @@ -305,7 +305,9 @@ randomArray :: forall ix e g. Index ix => g -- ^ Initial random value generator -> (g -> (g, g)) - -- ^ A function that can split a generator in two independent generators + -- ^ A function that can split a generator into two independent + -- generators. It will only be called if supplied computation strategy + -- needs more than one worker threads. -> (g -> (e, g)) -- ^ A function that produces a random value and the next generator -> Comp -- ^ Computation strategy. diff --git a/massiv/src/Data/Massiv/Array/Ops/Transform.hs b/massiv/src/Data/Massiv/Array/Ops/Transform.hs index fa3fa294..61d38de8 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Transform.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Transform.hs @@ -123,7 +123,7 @@ extractFromToM :: extractFromToM sIx eIx = extractM sIx (Sz (liftIndex2 (-) eIx sIx)) {-# INLINE extractFromToM #-} --- | Same as `extractFromTo`, but throws an error on invalid indices. +-- | Same as `extractFromToM`, but throws an error on invalid indices. -- -- @since 0.2.4 extractFromTo' :: diff --git a/stack-extra-deps.yaml b/stack-extra-deps.yaml index aa63674f..0e62a6b0 100644 --- a/stack-extra-deps.yaml +++ b/stack-extra-deps.yaml @@ -4,6 +4,7 @@ packages: - 'massiv-test/' flags: {} extra-deps: +- scheduler-2.0.0@sha256:3f053e3ff024fdcdd0983fb901313ef979921bc27e12dec97cd330878ddf78b1,2525 - unliftio-0.2.18@sha256:87fb541127d21939d3efc49ed9bc3df6eadc9eb06ffa7755fc857f62e15daf20,3395 - pvar-1.0.0.0@sha256:3d4a6855b0960baee78f6956f082eb8aa1cede52d2955b7faef186d1133f7964,1893 - primitive-0.7.1.0@sha256:6a237bb338bcc43193077ff8e8c0f0ce2de14c652231496a15672e8b563a07e2,2604 @@ -17,7 +18,3 @@ extra-deps: - hspec-core-2.8.2@sha256:251d8d96d06078ee41c4350c707fbdb9235cbcac3d89ea4a4075f1715d7c3a8f,4955 - hspec-discover-2.8.2@sha256:e7d9f95303e3763114aa36b7f115bfa131ba490d8018c6468089b502dd208ec8,2183 - hspec-expectations-0.8.2@sha256:e2db24881baadc2d9d23b03cb629e80dcbda89a6b04ace9adb5f4d02ef8b31aa,1594 -- github: lehins/haskell-scheduler - commit: c5506d20d96fc3fb00c213791243b7246d39e822 - subdirs: - - scheduler diff --git a/stack.yaml b/stack.yaml index 80c2eabc..81c6a14b 100644 --- a/stack.yaml +++ b/stack.yaml @@ -4,7 +4,4 @@ packages: - 'massiv-test/' flags: {} extra-deps: -- github: lehins/haskell-scheduler - commit: c5506d20d96fc3fb00c213791243b7246d39e822 - subdirs: - - scheduler +- scheduler-2.0.0@sha256:3f053e3ff024fdcdd0983fb901313ef979921bc27e12dec97cd330878ddf78b1,2525 From 524704fa6b581d3df77e1ddc4891bef9b53df1d2 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Thu, 29 Jul 2021 03:09:27 +0300 Subject: [PATCH 56/65] Fix an issue with loading a nested 3D list. Speed up parallel loading loading of nested list. Add a benchmark --- massiv-bench/bench/List.hs | 45 +++++++++++ massiv-bench/massiv-bench.cabal | 15 ++++ .../Test/Massiv/Array/Ops/ConstructSpec.hs | 26 +++---- massiv/src/Data/Massiv/Core/List.hs | 76 ++++++++++--------- stack.yaml | 1 + 5 files changed, 114 insertions(+), 49 deletions(-) create mode 100644 massiv-bench/bench/List.hs diff --git a/massiv-bench/bench/List.hs b/massiv-bench/bench/List.hs new file mode 100644 index 00000000..1c4e7089 --- /dev/null +++ b/massiv-bench/bench/List.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Main where + +import Criterion.Main +import Data.Massiv.Array as A +-- import Data.Massiv.Array.Manifest.Vector as A +-- import Data.Massiv.Bench as A +import qualified Data.Vector.Primitive as VP +-- import Data.Primitive.ByteArray +--import Data.Primitive.PrimArray as Prim +import System.Random.Stateful + +main :: IO () +main = do + let (stdGen1, _stdGen2) = split $ mkStdGen 2021 + sz2d = Sz2 500 5000 + arr2d = compute (uniformArray stdGen1 Seq sz2d) :: Array P Ix2 Int + sz3d = Sz3 500 100 50 + --arr3d = compute (uniformArray stdGen1 Seq sz3d) :: Array P Ix3 Int + arr3d <- resizeM sz3d arr2d + defaultMain + [ bgroup + "fromLists (Seq)" + [ env (return $ toLists3 arr3d) $ \xs -> + bench "Array P Ix3" $ nfIO (A.fromListsM @P @Ix3 Seq xs) + , env (return $ toLists2 arr2d) $ \xs -> + bench "Array P Ix2" $ nfIO (A.fromListsM @P @Ix2 Seq xs) + , env (return $ toList arr3d) $ \xs -> + bench "Array P Ix1" $ nfIO (A.fromListsM @P @Ix1 Seq xs) + , env (return $ toList arr3d) $ \xs -> + bench "VP.Vector" $ nf VP.fromList xs + ] + , bgroup + "fromLists (Par)" + [ env (return $ toLists3 arr3d) $ \xs -> + bench "Array P Ix3" $ nfIO (A.fromListsM @P @Ix3 Par xs) + , env (return $ toLists2 arr2d) $ \xs -> + bench "Array P Ix2" $ nfIO (A.fromListsM @P @Ix2 Par xs) + , env (return $ toList arr3d) $ \xs -> + bench "Array P Ix1" $ nfIO (A.fromListsM @P @Ix1 Par xs) + ] + ] diff --git a/massiv-bench/massiv-bench.cabal b/massiv-bench/massiv-bench.cabal index ee1f15d9..3f2d37fa 100644 --- a/massiv-bench/massiv-bench.cabal +++ b/massiv-bench/massiv-bench.cabal @@ -220,6 +220,21 @@ benchmark traverse , transformers default-language: Haskell2010 +benchmark list + type: exitcode-stdio-1.0 + hs-source-dirs: bench + main-is: List.hs + ghc-options: -Wall -threaded -O2 -rtsopts -with-rtsopts=-N + build-depends: base + , criterion + , deepseq + , massiv + , massiv-bench + , vector + , primitive + , random + default-language: Haskell2010 + -- benchmark fuse-seq -- type: exitcode-stdio-1.0 -- hs-source-dirs: bench diff --git a/massiv-test/tests/Test/Massiv/Array/Ops/ConstructSpec.hs b/massiv-test/tests/Test/Massiv/Array/Ops/ConstructSpec.hs index 4c295f0c..9dfd738e 100644 --- a/massiv-test/tests/Test/Massiv/Array/Ops/ConstructSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/Ops/ConstructSpec.hs @@ -72,24 +72,24 @@ prop_excFromToListIx3 comp ls3 specConstructIx1 :: Spec specConstructIx1 = do - it "toFromList" $ property (prop_toFromList (Proxy :: Proxy Ix1)) - it "toFromListIsList" $ property (prop_toFromListIsList (Proxy :: Proxy Ix1)) - it "rangeEqRangeStep1" $ property prop_rangeEqRangeStep1 - it "rangeEqEnumFromN" $ property prop_rangeEqEnumFromN - it "rangeStepEqEnumFromStepN" $ property prop_rangeStepEqEnumFromStepN - it "rangeStepExc" $ property prop_rangeStepExc + prop "toFromList" $ prop_toFromList (Proxy :: Proxy Ix1) + prop "toFromListIsList" $ prop_toFromListIsList (Proxy :: Proxy Ix1) + prop "rangeEqRangeStep1" prop_rangeEqRangeStep1 + prop "rangeEqEnumFromN" prop_rangeEqEnumFromN + prop "rangeStepEqEnumFromStepN" prop_rangeStepEqEnumFromStepN + prop "rangeStepExc" prop_rangeStepExc specConstructIx2 :: Spec specConstructIx2 = do - it "toFromList" $ property (prop_toFromList (Proxy :: Proxy Ix2)) - it "toFromListIsList" $ property (prop_toFromListIsList (Proxy :: Proxy Ix2)) - it "excFromToListIx2" $ property prop_excFromToListIx2 + prop "toFromList" $ (prop_toFromList (Proxy :: Proxy Ix2)) + prop "toFromListIsList" $ (prop_toFromListIsList (Proxy :: Proxy Ix2)) + prop "excFromToListIx2" $ prop_excFromToListIx2 specConstructIx3 :: Spec specConstructIx3 = do - it "toFromList" $ property (prop_toFromList (Proxy :: Proxy Ix3)) - it "toFromListIsList" $ property (prop_toFromListIsList (Proxy :: Proxy Ix3)) - it "excFromToListIx3" $ property prop_excFromToListIx3 + prop "toFromList" $ (prop_toFromList (Proxy :: Proxy Ix3)) + prop "toFromListIsList" $ (prop_toFromListIsList (Proxy :: Proxy Ix3)) + prop "excFromToListIx3" $ prop_excFromToListIx3 mkIntermediate :: Int -> Array U Ix1 Int mkIntermediate t = A.fromList Seq [t + 50, t + 75] @@ -125,4 +125,4 @@ spec = do describe "Ix2" specConstructIx2 describe "Ix3" specConstructIx3 describe "Expand" specExpand - describe "Unfolding" $ it "unfoldrS_" $ property prop_unfoldrList + describe "Unfolding" $ prop "unfoldrS_" prop_unfoldrList diff --git a/massiv/src/Data/Massiv/Core/List.hs b/massiv/src/Data/Massiv/Core/List.hs index a15e1d65..28ddf28f 100644 --- a/massiv/src/Data/Massiv/Core/List.hs +++ b/massiv/src/Data/Massiv/Core/List.hs @@ -161,29 +161,28 @@ outerLength = SafeSz . length . unList . lData instance Ragged L Ix1 e where emptyR comp = LArray comp (List []) {-# INLINE emptyR #-} - consR x arr = arr { lData = coerce (x : coerce (lData arr)) } + consR x arr = arr {lData = coerce (x : coerce (lData arr))} {-# INLINE consR #-} unconsR LArray {..} = case L.uncons $ coerce lData of - Nothing -> Nothing + Nothing -> Nothing Just (x, xs) -> Just (x, LArray lComp (coerce xs)) {-# INLINE unconsR #-} flattenRagged = id {-# INLINE flattenRagged #-} generateRaggedM !comp !k f = do - xs <- loopDeepM 0 (< coerce k) (+ 1) [] $ \i acc -> do - e <- f i - return (e:acc) + xs <- + loopDeepM 0 (< coerce k) (+ 1) [] $ \i acc -> do + e <- f i + return (e : acc) return $ LArray comp $ coerce xs {-# INLINE generateRaggedM #-} - loadRaggedST scheduler xs uWrite start end sz = - scheduleWork scheduler $ do - leftOver <- - loopM start (< end) (+ 1) xs $ \i xs' -> - case unconsR xs' of - Nothing -> throwM (DimTooShortException sz (outerLength xs)) - Just (y, ys) -> uWrite i y >> return ys - unless (isNull leftOver) (throwM DimTooLongException) + loadRaggedST _scheduler xs uWrite start end sz = go (unList (lData xs)) start + where + go (y:ys) i + | i < end = uWrite i y >> go ys (i + 1) + | otherwise = throwM (DimTooShortException sz (outerLength xs)) + go [] i = when (i /= end) $ throwM DimTooLongException {-# INLINE loadRaggedST #-} raggedFormat f _ arr = L.concat $ "[ " : L.intersperse ", " (map f (coerce (lData arr))) ++ [" ]"] @@ -217,25 +216,29 @@ instance Ragged L Ix2 e where where xs = concatMap (unList . lData . flattenRagged . LArray (lComp arr)) (unList (lData arr)) {-# INLINE flattenRagged #-} - loadRaggedST scheduler xs uWrite start end sz = do - let (k, szL) = unconsSz sz - step = totalElem szL - isZero = totalElem sz == 0 - when (isZero && isNotNull (flattenRagged xs)) (throwM DimTooLongException) - unless isZero $ do + loadRaggedST scheduler xs uWrite start end sz + | isZeroSz sz = when (isNotNull (flattenRagged xs)) (throwM DimTooLongException) + | otherwise = do + let (k, szL) = unconsSz sz + step = totalElem szL leftOver <- - loopM start (< end) (+ step) xs $ \i zs -> - case unconsR zs of - Nothing -> throwM (DimTooShortException k (outerLength xs)) - Just (y, ys) -> do - _ <- loadRaggedST scheduler y uWrite i (i + step) szL - return ys - unless (isNull leftOver) (throwM DimTooLongException) + loopM start (< end) (+ step) (coerce (lData xs)) $ \i zs -> + case zs of + [] -> throwM (DimTooShortException k (outerLength xs)) + (y:ys) -> do + scheduleWork_ scheduler $ + let end' = i + step + go (a:as) j + | j < end' = uWrite j a >> go as (j + 1) + | otherwise = throwM (DimTooShortException szL (Sz (length y))) + go [] j = when (j /= end') $ throwM DimTooLongException + in go y i + pure ys + unless (null leftOver) (throwM DimTooLongException) {-# INLINE loadRaggedST #-} raggedFormat f sep (LArray comp xs) = showN (\s y -> raggedFormat f s (LArray comp y :: Array L Ix1 e)) sep (coerce xs) - instance ( Shape L (IxN n) , Shape LN (Ix (n - 1)) , Ragged L (Ix (n - 1)) e @@ -262,19 +265,20 @@ instance ( Shape L (IxN n) where xs = concatMap (unList . lData . flattenRagged . LArray (lComp arr)) (unList (lData arr)) {-# INLINE flattenRagged #-} - loadRaggedST scheduler xs uWrite start end sz = do - let (k, szL) = unconsSz sz - step = totalElem szL - isZero = totalElem sz == 0 - when (isZero && isNotNull (flattenRagged xs)) (throwM DimTooLongException) - unless isZero $ do + loadRaggedST scheduler xs uWrite start end sz + | isZeroSz sz = when (isNotNull (flattenRagged xs)) (throwM DimTooLongException) + | otherwise = do + let (k, szL) = unconsSz sz + step = totalElem szL + subScheduler + | end - start < numWorkers scheduler * step = scheduler + | otherwise = trivialScheduler_ leftOver <- loopM start (< end) (+ step) xs $ \i zs -> case unconsR zs of Nothing -> throwM (DimTooShortException k (outerLength xs)) - Just (y, ys) -> do - _ <- loadRaggedST scheduler y uWrite i (i + step) szL - return ys + Just (y, ys) -> + ys <$ scheduleWork_ scheduler (loadRaggedST subScheduler y uWrite i (i + step) szL) unless (isNull leftOver) (throwM DimTooLongException) {-# INLINE loadRaggedST #-} raggedFormat f sep (LArray comp xs) = diff --git a/stack.yaml b/stack.yaml index 81c6a14b..ea465829 100644 --- a/stack.yaml +++ b/stack.yaml @@ -2,6 +2,7 @@ resolver: lts-18.3 packages: - 'massiv/' - 'massiv-test/' +- 'massiv-bench/' flags: {} extra-deps: - scheduler-2.0.0@sha256:3f053e3ff024fdcdd0983fb901313ef979921bc27e12dec97cd330878ddf78b1,2525 From a4b406df66179ffd1fa98a0386f9fcbf97086c83 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Thu, 29 Jul 2021 13:41:55 +0300 Subject: [PATCH 57/65] Ensure empty arrays are always equal, regardless of their size. Improve error reporting for lists loading --- .../Test/Massiv/Array/Ops/ConstructSpec.hs | 17 ++++----- massiv/CHANGELOG.md | 1 + massiv/src/Data/Massiv/Array/Delayed/Pull.hs | 16 ++++++--- massiv/src/Data/Massiv/Array/Manifest/List.hs | 8 +++-- massiv/src/Data/Massiv/Core/Index/Internal.hs | 25 +++++++++---- massiv/src/Data/Massiv/Core/List.hs | 36 +++++++++---------- 6 files changed, 61 insertions(+), 42 deletions(-) diff --git a/massiv-test/tests/Test/Massiv/Array/Ops/ConstructSpec.hs b/massiv-test/tests/Test/Massiv/Array/Ops/ConstructSpec.hs index 9dfd738e..4d8dc8d3 100644 --- a/massiv-test/tests/Test/Massiv/Array/Ops/ConstructSpec.hs +++ b/massiv-test/tests/Test/Massiv/Array/Ops/ConstructSpec.hs @@ -30,20 +30,21 @@ prop_rangeStepExc from to = prop_toFromListIsList :: (Show (Array U ix Int), GHC.IsList (Array U ix Int), Index ix) => Proxy ix - -> ArrNE U ix Int + -> Array U ix Int -> Property -prop_toFromListIsList _ (ArrNE arr) = arr === GHC.fromList (GHC.toList arr) +prop_toFromListIsList _ arr = arr === GHC.fromList (GHC.toList arr) prop_toFromList :: - forall ix . (Show (Array U ix Int), Ragged L ix Int) + forall ix . (Show (Array B ix Int), Ragged L ix Int) => Proxy ix - -> ArrNE U ix Int + -> Array B ix Int -> Property -prop_toFromList _ (ArrNE arr) = comp === comp' .&&. arr === arr' - where comp = getComp arr - arr' = fromLists' comp (toLists arr) - comp' = getComp arr' +prop_toFromList _ arr = comp === comp' .&&. arr === arr' + where + comp = getComp arr + arr' = fromLists' comp $ toLists arr + comp' = getComp arr' prop_excFromToListIx2 :: Comp -> [[Int]] -> Property diff --git a/massiv/CHANGELOG.md b/massiv/CHANGELOG.md index 8d6b597a..b55451d8 100644 --- a/massiv/CHANGELOG.md +++ b/massiv/CHANGELOG.md @@ -47,6 +47,7 @@ * Add `Uniform`, `UniformRange` and `Random` instances for `Ix2`, `IxN`, `Dim`, `Sz` and `Stride` * Consolidate `Mutable` into `Manifest` type class and move the `MArray` data family outside of the class. +* Make sure empty arrays are always equal, regardless of their size. # 0.6.1 diff --git a/massiv/src/Data/Massiv/Array/Delayed/Pull.hs b/massiv/src/Data/Massiv/Array/Delayed/Pull.hs index 74fc5b5c..2d52c6fd 100644 --- a/massiv/src/Data/Massiv/Array/Delayed/Pull.hs +++ b/massiv/src/Data/Massiv/Array/Delayed/Pull.hs @@ -207,16 +207,22 @@ delay arr = DArray (getComp arr) (size arr) (unsafeIndex arr) "delay" [~1] forall (arr :: Array D ix e) . delay arr = arr #-} --- | Compute array equality by applying a comparing function to each element. +-- | Compute array equality by applying a comparing function to each +-- element. Empty arrays are always equal, regardless of their size. -- -- @since 0.5.7 eqArrays :: (Index ix, Source r1 e1, Source r2 e2) => (e1 -> e2 -> Bool) -> Array r1 ix e1 -> Array r2 ix e2 -> Bool eqArrays f arr1 arr2 = - (size arr1 == size arr2) && - not (A.any not - (DArray (getComp arr1 <> getComp arr2) (size arr1) $ \ix -> - f (unsafeIndex arr1 ix) (unsafeIndex arr2 ix))) + let sz1 = size arr1 + sz2 = size arr2 + in (sz1 == sz2 && + not + (A.any + not + (DArray (getComp arr1 <> getComp arr2) (size arr1) $ \ix -> + f (unsafeIndex arr1 ix) (unsafeIndex arr2 ix)))) || + (isZeroSz sz1 && isZeroSz sz2) {-# INLINE eqArrays #-} -- | Compute array ordering by applying a comparing function to each element. diff --git a/massiv/src/Data/Massiv/Array/Manifest/List.hs b/massiv/src/Data/Massiv/Array/Manifest/List.hs index d7e001b6..bacc6c63 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/List.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/List.hs @@ -74,10 +74,12 @@ fromList = fromLists' -- , [ [4,5] ] -- ] -- ) --- >>> fromListsM Seq [[[1,2,3]],[[4,5]]] :: Maybe (Array B Ix3 Int) +-- >>> fromListsM Seq [[[1,2,3]],[[4,5]]] :: Maybe (Array B Ix3 Integer) -- Nothing --- >>> fromListsM Seq [[[1,2,3]],[[4,5]]] :: IO (Array B Ix3 Int) --- *** Exception: DimTooShortException: expected (Sz1 3), got (Sz1 2) +-- >>> fromListsM Seq [[[1,2,3]],[[4,5,6],[7,8,9]]] :: IO (Array B Ix3 Integer) +-- *** Exception: DimTooLongException for (Dim 2): expected (Sz1 1), got (Sz1 2) +-- >>> fromListsM Seq [[1,2,3,4],[5,6,7]] :: IO (Matrix B Integer) +-- *** Exception: DimTooShortException for (Dim 1): expected (Sz1 4), got (Sz1 3) -- -- @since 0.3.0 fromListsM :: diff --git a/massiv/src/Data/Massiv/Core/Index/Internal.hs b/massiv/src/Data/Massiv/Core/Index/Internal.hs index 3588929b..1d4929b1 100644 --- a/massiv/src/Data/Massiv/Core/Index/Internal.hs +++ b/massiv/src/Data/Massiv/Core/Index/Internal.hs @@ -862,16 +862,27 @@ instance Show SizeException where -- -- @since 0.3.0 data ShapeException - = DimTooShortException !(Sz Ix1) !(Sz Ix1) - | DimTooLongException + = DimTooShortException !Dim !(Sz Ix1) !(Sz Ix1) + -- ^ Across a specific dimension there was not enough elements for the supplied size + | DimTooLongException !Dim !(Sz Ix1) !(Sz Ix1) + -- ^ Across a specific dimension there was too many elements for the supplied size + | ShapeNonEmpty + -- ^ Expected an empty size, but the shape was not empty. deriving Eq instance Show ShapeException where - showsPrec _ DimTooLongException = ("DimTooLongException" ++) - showsPrec n (DimTooShortException sz sz') = - showsPrecWrapped - n - (("DimTooShortException: expected (" ++) . shows sz . ("), got (" ++) . shows sz' . (")" ++)) + showsPrec n = + \case + DimTooShortException d sz sz' -> showsShapeExc "DimTooShortException" d sz sz' + DimTooLongException d sz sz' -> showsShapeExc "DimTooLongException" d sz sz' + ShapeNonEmpty -> ("ShapeNonEmpty" ++) + where + showsShapeExc tyName d sz sz' = + showsPrecWrapped + n + ((tyName ++) . + (" for " ++) . + shows d . (": expected (" ++) . shows sz . ("), got (" ++) . shows sz' . (")" ++)) instance Exception ShapeException diff --git a/massiv/src/Data/Massiv/Core/List.hs b/massiv/src/Data/Massiv/Core/List.hs index 28ddf28f..dee4d9aa 100644 --- a/massiv/src/Data/Massiv/Core/List.hs +++ b/massiv/src/Data/Massiv/Core/List.hs @@ -51,10 +51,6 @@ type family ListItem ix e :: Type where newtype instance Array LN ix e = List { unList :: [Elt LN ix e] } ---TODO remove -instance Strategy LN where - getComp _ = Seq - setComp _ = id instance Coercible (Elt LN ix e) (ListItem ix e) => IsList (Array LN ix e) where @@ -181,8 +177,8 @@ instance Ragged L Ix1 e where where go (y:ys) i | i < end = uWrite i y >> go ys (i + 1) - | otherwise = throwM (DimTooShortException sz (outerLength xs)) - go [] i = when (i /= end) $ throwM DimTooLongException + | otherwise = throwM $ DimTooLongException 1 sz (outerLength xs) + go [] i = when (i /= end) $ throwM $ DimTooShortException 1 sz (outerLength xs) {-# INLINE loadRaggedST #-} raggedFormat f _ arr = L.concat $ "[ " : L.intersperse ", " (map f (coerce (lData arr))) ++ [" ]"] @@ -217,24 +213,24 @@ instance Ragged L Ix2 e where xs = concatMap (unList . lData . flattenRagged . LArray (lComp arr)) (unList (lData arr)) {-# INLINE flattenRagged #-} loadRaggedST scheduler xs uWrite start end sz - | isZeroSz sz = when (isNotNull (flattenRagged xs)) (throwM DimTooLongException) + | isZeroSz sz = when (isNotNull (flattenRagged xs)) (throwM ShapeNonEmpty) | otherwise = do let (k, szL) = unconsSz sz step = totalElem szL leftOver <- loopM start (< end) (+ step) (coerce (lData xs)) $ \i zs -> case zs of - [] -> throwM (DimTooShortException k (outerLength xs)) + [] -> throwM (DimTooShortException 2 k (outerLength xs)) (y:ys) -> do scheduleWork_ scheduler $ let end' = i + step go (a:as) j | j < end' = uWrite j a >> go as (j + 1) - | otherwise = throwM (DimTooShortException szL (Sz (length y))) - go [] j = when (j /= end') $ throwM DimTooLongException + | otherwise = throwM $ DimTooLongException 1 szL (Sz (length y)) + go [] j = when (j /= end') $ throwM (DimTooShortException 1 szL (Sz (length y))) in go y i pure ys - unless (null leftOver) (throwM DimTooLongException) + unless (null leftOver) $ throwM $ DimTooLongException 2 k (outerLength xs) {-# INLINE loadRaggedST #-} raggedFormat f sep (LArray comp xs) = showN (\s y -> raggedFormat f s (LArray comp y :: Array L Ix1 e)) sep (coerce xs) @@ -266,7 +262,7 @@ instance ( Shape L (IxN n) xs = concatMap (unList . lData . flattenRagged . LArray (lComp arr)) (unList (lData arr)) {-# INLINE flattenRagged #-} loadRaggedST scheduler xs uWrite start end sz - | isZeroSz sz = when (isNotNull (flattenRagged xs)) (throwM DimTooLongException) + | isZeroSz sz = when (isNotNull (flattenRagged xs)) (throwM ShapeNonEmpty) | otherwise = do let (k, szL) = unconsSz sz step = totalElem szL @@ -276,10 +272,10 @@ instance ( Shape L (IxN n) leftOver <- loopM start (< end) (+ step) xs $ \i zs -> case unconsR zs of - Nothing -> throwM (DimTooShortException k (outerLength xs)) + Nothing -> throwM (DimTooShortException (dimensions sz) k (outerLength xs)) Just (y, ys) -> ys <$ scheduleWork_ scheduler (loadRaggedST subScheduler y uWrite i (i + step) szL) - unless (isNull leftOver) (throwM DimTooLongException) + unless (isNull leftOver) $ throwM $ DimTooLongException (dimensions sz) k (outerLength xs) {-# INLINE loadRaggedST #-} raggedFormat f sep (LArray comp xs) = showN (\s y -> raggedFormat f s (LArray comp y :: Array L (Ix (n - 1)) e)) sep (coerce xs) @@ -343,7 +339,7 @@ toListArray !arr = makeArray (getComp arr) (outerSize arr) (unsafeIndex arr) instance (Ragged L ix e, Show e) => Show (Array L ix e) where - showsPrec = showsArrayLAsPrec (Proxy :: Proxy L) + showsPrec n arr = showsArrayLAsPrec (Proxy :: Proxy L) (outerSize arr) n arr instance (Ragged L ix e, Show e) => Show (Array LN ix e) where show arr = " " ++ raggedFormat show "\n " arrL @@ -361,15 +357,16 @@ showN fShow lnPrefix ls = showsArrayLAsPrec :: forall r ix e. (Ragged L ix e, Typeable r, Show e) => Proxy r + -> Sz ix -> Int -> Array L ix e -- Array to show -> ShowS -showsArrayLAsPrec pr n arr = +showsArrayLAsPrec pr sz n arr = opp . ("Array " ++) . showsTypeRep (typeRep pr) . (' ':) . - showsPrec 1 (getComp arr) . (" (" ++) . shows (outerSize arr) . (")\n" ++) . shows lnarr . clp + showsPrec 1 (getComp arr) . (" (" ++) . shows sz . (")\n" ++) . shows lnarr . clp where (opp, clp) = if n == 0 @@ -386,10 +383,11 @@ showsArrayPrec :: -> Int -> Array r ix e -- Array to show -> ShowS -showsArrayPrec f n arr = showsArrayLAsPrec (Proxy :: Proxy r) n larr +showsArrayPrec f n arr = showsArrayLAsPrec (Proxy :: Proxy r) sz n larr where + sz = size arr' arr' = f arr - larr = makeArray (getComp arr') (size arr') (evaluate' arr') :: Array L ix e + larr = makeArray (getComp arr') sz (evaluate' arr') :: Array L ix e -- | Helper function for declaring `Show` instances for arrays From 97804bbb5171c841e45d82b39f0fb6696f662b3e Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Thu, 29 Jul 2021 18:17:47 +0300 Subject: [PATCH 58/65] Attempt to separate build step from the test step on CI --- .github/workflows/haskell.yml | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index 609fddc1..6b6b4fb6 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -99,6 +99,12 @@ jobs: [ -n "${{ matrix.ghc }}" ] && [ "${{ matrix.os }}" == "ubuntu-latest" ] && STACK_ARGS="$STACK_ARGS --system-ghc" [ -n "${{ matrix.stack-yaml }}" ] && STACK_YAML=${{ matrix.stack-yaml }} stack $STACK_ARGS runghc git-modtime.hs + - name: Build + run: | + set -ex + [ -n "${{ matrix.ghc }}" ] && [ "${{ matrix.os }}" == "ubuntu-latest" ] && STACK_ARGS="$STACK_ARGS --system-ghc" + [ -n "${{ matrix.stack-yaml }}" ] && STACK_YAML=${{ matrix.stack-yaml }} + stack $STACK_ARGS build --test --no-run-tests --bench --no-run-benchmarks --haddock --no-haddock-deps - name: Tests env: COVERALLS_TOKEN: ${{ secrets.COVERALLS_TOKEN }} @@ -112,7 +118,6 @@ jobs: curl -L https://github.com/rubik/stack-hpc-coveralls/releases/download/v0.0.6.1/shc-linux-x64-8.8.4.tar.bz2 | tar xj shc ./shc --repo-token="$COVERALLS_TOKEN" --partial-coverage --fetch-coverage combined custom else - stack $STACK_ARGS test --no-run-tests --bench --no-run-benchmarks --haddock --no-haddock-deps stack $STACK_ARGS test massiv-test:tests stack $STACK_ARGS test massiv:doctests fi From 86a825b2c47f65643c8f6a2a51d9df1591992862 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Thu, 29 Jul 2021 23:32:14 +0300 Subject: [PATCH 59/65] Fix double building with coverage on CI --- .github/workflows/haskell.yml | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index 6b6b4fb6..623703e8 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -104,7 +104,11 @@ jobs: set -ex [ -n "${{ matrix.ghc }}" ] && [ "${{ matrix.os }}" == "ubuntu-latest" ] && STACK_ARGS="$STACK_ARGS --system-ghc" [ -n "${{ matrix.stack-yaml }}" ] && STACK_YAML=${{ matrix.stack-yaml }} - stack $STACK_ARGS build --test --no-run-tests --bench --no-run-benchmarks --haddock --no-haddock-deps + if [ "${{ matrix.os }}.${{ matrix.resolver }}" == "ubuntu-latest.lts-14" ] && [ -n "${COVERALLS_TOKEN}" ]; then + stack $STACK_ARGS build --coverage --test --no-run-tests --haddock --no-haddock-deps + else + stack $STACK_ARGS build --test --no-run-tests --bench --no-run-benchmarks --haddock --no-haddock-deps + fi - name: Tests env: COVERALLS_TOKEN: ${{ secrets.COVERALLS_TOKEN }} @@ -112,8 +116,9 @@ jobs: set -ex [ -n "${{ matrix.ghc }}" ] && [ "${{ matrix.os }}" == "ubuntu-latest" ] && STACK_ARGS="$STACK_ARGS --system-ghc" [ -n "${{ matrix.stack-yaml }}" ] && STACK_YAML=${{ matrix.stack-yaml }} + echo "${STACK_ARGS}" if [ "${{ matrix.os }}.${{ matrix.resolver }}" == "ubuntu-latest.lts-14" ] && [ -n "${COVERALLS_TOKEN}" ]; then - stack $STACK_ARGS test massiv-test:tests --coverage --haddock --no-haddock-deps + stack $STACK_ARGS test massiv-test:tests --coverage stack $STACK_ARGS hpc report --all curl -L https://github.com/rubik/stack-hpc-coveralls/releases/download/v0.0.6.1/shc-linux-x64-8.8.4.tar.bz2 | tar xj shc ./shc --repo-token="$COVERALLS_TOKEN" --partial-coverage --fetch-coverage combined custom From eebbf78548a3f8b6eeb5f1c3c20c200ea67265d6 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Fri, 30 Jul 2021 00:46:24 +0300 Subject: [PATCH 60/65] Fix `liftArray2` story. Fixup CI * Remove `liftArray2`. Instead add `liftArray2'` and `liftArray2M` that don't behave like a `map` for singleton argument. * Expose `liftNumArray2M` --- .github/workflows/haskell.yml | 6 +- massiv/CHANGELOG.md | 4 +- massiv/src/Data/Massiv/Array/Delayed.hs | 1 + massiv/src/Data/Massiv/Array/Delayed/Pull.hs | 35 +++++++--- massiv/src/Data/Massiv/Array/Numeric.hs | 71 ++++++++++++-------- 5 files changed, 76 insertions(+), 41 deletions(-) diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index 623703e8..adf3af84 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -100,12 +100,14 @@ jobs: [ -n "${{ matrix.stack-yaml }}" ] && STACK_YAML=${{ matrix.stack-yaml }} stack $STACK_ARGS runghc git-modtime.hs - name: Build + env: + COVERALLS_TOKEN: ${{ secrets.COVERALLS_TOKEN }} run: | set -ex [ -n "${{ matrix.ghc }}" ] && [ "${{ matrix.os }}" == "ubuntu-latest" ] && STACK_ARGS="$STACK_ARGS --system-ghc" [ -n "${{ matrix.stack-yaml }}" ] && STACK_YAML=${{ matrix.stack-yaml }} if [ "${{ matrix.os }}.${{ matrix.resolver }}" == "ubuntu-latest.lts-14" ] && [ -n "${COVERALLS_TOKEN}" ]; then - stack $STACK_ARGS build --coverage --test --no-run-tests --haddock --no-haddock-deps + stack $STACK_ARGS build massiv-test:tests --coverage --test --no-run-tests --haddock --no-haddock-deps else stack $STACK_ARGS build --test --no-run-tests --bench --no-run-benchmarks --haddock --no-haddock-deps fi @@ -118,7 +120,7 @@ jobs: [ -n "${{ matrix.stack-yaml }}" ] && STACK_YAML=${{ matrix.stack-yaml }} echo "${STACK_ARGS}" if [ "${{ matrix.os }}.${{ matrix.resolver }}" == "ubuntu-latest.lts-14" ] && [ -n "${COVERALLS_TOKEN}" ]; then - stack $STACK_ARGS test massiv-test:tests --coverage + stack $STACK_ARGS test massiv-test:tests --coverage --haddock --no-haddock-deps stack $STACK_ARGS hpc report --all curl -L https://github.com/rubik/stack-hpc-coveralls/releases/download/v0.0.6.1/shc-linux-x64-8.8.4.tar.bz2 | tar xj shc ./shc --repo-token="$COVERALLS_TOKEN" --partial-coverage --fetch-coverage combined custom diff --git a/massiv/CHANGELOG.md b/massiv/CHANGELOG.md index b55451d8..a71f8f13 100644 --- a/massiv/CHANGELOG.md +++ b/massiv/CHANGELOG.md @@ -20,7 +20,9 @@ * Consolidate `OuterSlice` into `Source` * Add `Strategy` and move `setComp` (from `Construct`) and `getComp` (from `Load`) in there. * Remove `ix` from `Mutable`, `Manifest`, `Source` -* Remove `liftArray2`. +* Remove `liftArray2`. Instead add `liftArray2'` and `liftArray2M` that don't behave + like a `map` for singleton argument. +* Expose `liftNumArray2M` * Prevent `showsArrayPrec` from changing index type * Change function argument to monadic action for `unstablePartitionM` and `unsafeUnstablePartitionM` * Replace `snull` with a more generic `isNull` diff --git a/massiv/src/Data/Massiv/Array/Delayed.hs b/massiv/src/Data/Massiv/Array/Delayed.hs index 12500921..4a488dc9 100644 --- a/massiv/src/Data/Massiv/Array/Delayed.hs +++ b/massiv/src/Data/Massiv/Array/Delayed.hs @@ -11,6 +11,7 @@ module Data.Massiv.Array.Delayed -- ** Delayed Pull Array D(..) , delay + , liftArray2M -- ** Delayed Push Array , DL(..) , toLoadArray diff --git a/massiv/src/Data/Massiv/Array/Delayed/Pull.hs b/massiv/src/Data/Massiv/Array/Delayed/Pull.hs index 2d52c6fd..18190104 100644 --- a/massiv/src/Data/Massiv/Array/Delayed/Pull.hs +++ b/massiv/src/Data/Massiv/Array/Delayed/Pull.hs @@ -21,7 +21,8 @@ module Data.Massiv.Array.Delayed.Pull , eqArrays , compareArrays , imap - , liftArray2Matching + , liftArray2' + , liftArray2M , unsafeExtract , unsafeSlice , unsafeInnerSlice @@ -30,7 +31,7 @@ module Data.Massiv.Array.Delayed.Pull import Control.Applicative import qualified Data.Foldable as F import Data.Massiv.Array.Ops.Fold.Internal as A -import Data.Massiv.Core.Common +import Data.Massiv.Core.Common as A import Data.Massiv.Core.List (L, showArrayList, showsArrayPrec) import Data.Massiv.Core.Operations import Data.Massiv.Vector.Stream as S (steps) @@ -123,10 +124,10 @@ instance Functor (Array D ix) where instance Index ix => Applicative (Array D ix) where pure = singleton {-# INLINE pure #-} - (<*>) = liftArray2Matching id + (<*>) = liftArray2' id {-# INLINE (<*>) #-} #if MIN_VERSION_base(4,10,0) - liftA2 = liftArray2Matching + liftA2 = liftArray2' {-# INLINE liftA2 #-} #endif @@ -239,19 +240,35 @@ compareArrays f arr1 arr2 = f (unsafeIndex arr1 ix) (unsafeIndex arr2 ix)) {-# INLINE compareArrays #-} - -liftArray2Matching +-- | Same as `liftArray2M`, but throws an imprecise exception on mismatched +-- sizes. +-- +-- @since 1.0.0 +liftArray2' :: (HasCallStack, Index ix, Source r1 a, Source r2 b) => (a -> b -> e) -> Array r1 ix a -> Array r2 ix b -> Array D ix e -liftArray2Matching f !arr1 !arr2 +liftArray2' f arr1 arr2 = throwEither $ liftArray2M f arr1 arr2 +{-# INLINE liftArray2' #-} + + +-- | Similar to `Data.Massiv.Array.zipWith`, except dimensions of both arrays +-- have to be the same, otherwise it throws `SizeMismatchException`. +-- +-- @since 1.0.0 +liftArray2M + :: (Index ix, Source r1 a, Source r2 b, MonadThrow m) + => (a -> b -> e) -> Array r1 ix a -> Array r2 ix b -> m (Array D ix e) +liftArray2M f !arr1 !arr2 | sz1 == sz2 = + pure $ DArray (getComp arr1 <> getComp arr2) sz1 (\ !ix -> f (unsafeIndex arr1 ix) (unsafeIndex arr2 ix)) - | otherwise = throwEither $ Left $ toException $ SizeMismatchException (size arr1) (size arr2) + | isZeroSz sz1 && isZeroSz sz2 = pure A.empty + | otherwise = throwM $ SizeMismatchException (size arr1) (size arr2) where sz1 = size arr1 sz2 = size arr2 -{-# INLINE liftArray2Matching #-} +{-# INLINE liftArray2M #-} diff --git a/massiv/src/Data/Massiv/Array/Numeric.hs b/massiv/src/Data/Massiv/Array/Numeric.hs index 055e4eb3..50b5466e 100644 --- a/massiv/src/Data/Massiv/Array/Numeric.hs +++ b/massiv/src/Data/Massiv/Array/Numeric.hs @@ -15,6 +15,7 @@ module Data.Massiv.Array.Numeric ( -- * Numeric Numeric , NumericFloat + , liftNumArray2M -- ** Pointwise addition , (.+) , (+.) @@ -106,7 +107,7 @@ import Data.Massiv.Array.Manifest.Internal import Data.Massiv.Array.Ops.Map as A import Data.Massiv.Array.Ops.Construct import Data.Massiv.Core -import Data.Massiv.Core.Common +import Data.Massiv.Core.Common as A import Data.Massiv.Core.Operations import Prelude as P import System.IO.Unsafe @@ -119,28 +120,40 @@ infixr 8 .^, .^^ infixl 7 !*!, .*., .*, *., !/!, ./., ./, /., `quotA`, `remA`, `divA`, `modA` infixl 6 !+!, .+., .+, +., !-!, .-., .-, -. -liftArray2M :: +-- | Similar to `liftArray2M`, except it can be applied only to representations +-- with `Numeric` instance and result representation stays the same. +-- +-- @since 1.0.0 +liftNumArray2M :: (Index ix, Numeric r e, MonadThrow m) => (e -> e -> e) -> Array r ix e -> Array r ix e -> m (Array r ix e) -liftArray2M f a1 a2 +liftNumArray2M f a1 a2 | size a1 == size a2 = pure $ unsafeLiftArray2 f a1 a2 - | otherwise = throwM $ SizeMismatchException (size a1) (size a2) -{-# INLINE liftArray2M #-} + | isZeroSz sz1 && isZeroSz sz2 = pure $ unsafeResize zeroSz a1 + | otherwise = throwM $ SizeMismatchException sz1 sz2 + where + !sz1 = size a1 + !sz2 = size a2 +{-# INLINE liftNumArray2M #-} -liftNumericArray2M :: - (Size r, Index ix, MonadThrow m) +applyExactSize2M :: + (Index ix, Size r, MonadThrow m) => (Array r ix e -> Array r ix e -> Array r ix e) -> Array r ix e -> Array r ix e -> m (Array r ix e) -liftNumericArray2M f a1 a2 +applyExactSize2M f a1 a2 | size a1 == size a2 = pure $ f a1 a2 - | otherwise = throwM $ SizeMismatchException (size a1) (size a2) -{-# INLINE liftNumericArray2M #-} + | isZeroSz sz1 && isZeroSz sz2 = pure $ unsafeResize zeroSz a1 + | otherwise = throwM $ SizeMismatchException sz1 sz2 + where + !sz1 = size a1 + !sz2 = size a2 +{-# INLINE applyExactSize2M #-} -- | Add two arrays together pointwise. Same as `!+!` but produces monadic computation @@ -150,7 +163,7 @@ liftNumericArray2M f a1 a2 -- -- @since 0.4.0 (.+.) :: (Index ix, Numeric r e, MonadThrow m) => Array r ix e -> Array r ix e -> m (Array r ix e) -(.+.) = liftNumericArray2M additionPointwise +(.+.) = applyExactSize2M additionPointwise {-# INLINE (.+.) #-} -- | Add two arrays together pointwise. Prefer to use monadic version of this function @@ -193,7 +206,7 @@ liftNumericArray2M f a1 a2 -- @since 0.4.0 (.-.) :: (Index ix, Numeric r e, MonadThrow m) => Array r ix e -> Array r ix e -> m (Array r ix e) -(.-.) = liftNumericArray2M subtractionPointwise +(.-.) = applyExactSize2M subtractionPointwise {-# INLINE (.-.) #-} @@ -238,7 +251,7 @@ liftNumericArray2M f a1 a2 -- @since 0.4.0 (.*.) :: (Index ix, Numeric r e, MonadThrow m) => Array r ix e -> Array r ix e -> m (Array r ix e) -(.*.) = liftNumericArray2M multiplicationPointwise +(.*.) = applyExactSize2M multiplicationPointwise {-# INLINE (.*.) #-} @@ -818,7 +831,7 @@ signumA = unsafeLiftArray signum => Array r ix e -> Array r ix e -> m (Array r ix e) -(./.) = liftNumericArray2M divisionPointwise +(./.) = applyExactSize2M divisionPointwise {-# INLINE (./.) #-} @@ -931,7 +944,7 @@ logA = unsafeLiftArray log logBaseA :: (Index ix, Source r1 e, Source r2 e, Floating e) => Array r1 ix e -> Array r2 ix e -> Array D ix e -logBaseA = liftArray2Matching logBase +logBaseA = liftArray2' logBase {-# INLINE logBaseA #-} -- TODO: siwtch to -- (breaking) logBaseA :: Array r ix e -> e -> Array D ix e @@ -951,7 +964,7 @@ logBaseA = liftArray2Matching logBase (.**) :: (Index ix, Source r1 e, Source r2 e, Floating e) => Array r1 ix e -> Array r2 ix e -> Array D ix e -(.**) = liftArray2Matching (**) +(.**) = liftArray2' (**) {-# INLINE (.**) #-} -- TODO: -- !**! :: Array r1 ix e -> Array r2 ix e -> Array D ix e @@ -1078,9 +1091,9 @@ atanhA = unsafeLiftArray atanh -- -- @since 0.1.0 quotA - :: (Index ix, Source r1 e, Source r2 e, Integral e) + :: (HasCallStack, Index ix, Source r1 e, Source r2 e, Integral e) => Array r1 ix e -> Array r2 ix e -> Array D ix e -quotA = liftArray2Matching quot +quotA = liftArray2' quot {-# INLINE quotA #-} @@ -1092,9 +1105,9 @@ quotA = liftArray2Matching quot -- -- @since 0.1.0 remA - :: (Index ix, Source r1 e, Source r2 e, Integral e) + :: (HasCallStack, Index ix, Source r1 e, Source r2 e, Integral e) => Array r1 ix e -> Array r2 ix e -> Array D ix e -remA = liftArray2Matching rem +remA = liftArray2' rem {-# INLINE remA #-} -- | Perform a pointwise integer division where first array contains numerators and the @@ -1106,9 +1119,9 @@ remA = liftArray2Matching rem -- -- @since 0.1.0 divA - :: (Index ix, Source r1 e, Source r2 e, Integral e) + :: (HasCallStack, Index ix, Source r1 e, Source r2 e, Integral e) => Array r1 ix e -> Array r2 ix e -> Array D ix e -divA = liftArray2Matching div +divA = liftArray2' div {-# INLINE divA #-} -- TODO: -- * Array r ix e -> Array r ix e -> m (Array r ix e) @@ -1123,9 +1136,9 @@ divA = liftArray2Matching div -- -- @since 0.1.0 modA - :: (Index ix, Source r1 e, Source r2 e, Integral e) + :: (HasCallStack, Index ix, Source r1 e, Source r2 e, Integral e) => Array r1 ix e -> Array r2 ix e -> Array D ix e -modA = liftArray2Matching mod +modA = liftArray2' mod {-# INLINE modA #-} @@ -1139,9 +1152,9 @@ modA = liftArray2Matching mod -- -- @since 0.1.0 quotRemA - :: (Index ix, Source r1 e, Source r2 e, Integral e) + :: (HasCallStack, Index ix, Source r1 e, Source r2 e, Integral e) => Array r1 ix e -> Array r2 ix e -> (Array D ix e, Array D ix e) -quotRemA arr1 = A.unzip . liftArray2Matching quotRem arr1 +quotRemA arr1 = A.unzip . liftArray2' quotRem arr1 {-# INLINE quotRemA #-} @@ -1154,9 +1167,9 @@ quotRemA arr1 = A.unzip . liftArray2Matching quotRem arr1 -- -- @since 0.1.0 divModA - :: (Index ix, Source r1 e, Source r2 e, Integral e) + :: (HasCallStack, Index ix, Source r1 e, Source r2 e, Integral e) => Array r1 ix e -> Array r2 ix e -> (Array D ix e, Array D ix e) -divModA arr1 = A.unzip . liftArray2Matching divMod arr1 +divModA arr1 = A.unzip . liftArray2' divMod arr1 {-# INLINE divModA #-} @@ -1212,7 +1225,7 @@ atan2A :: => Array r ix e -> Array r ix e -> m (Array r ix e) -atan2A = liftArray2M atan2 +atan2A = liftNumArray2M atan2 {-# INLINE atan2A #-} -- | Same as `sumArraysM`, compute sum of arrays pointwise. All arrays must have the same From 54f9960a603de4c9b1b75643c97a6f9294fa0cb2 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Fri, 30 Jul 2021 02:36:33 +0300 Subject: [PATCH 61/65] Remove LN representation in favor of List. Simplify Ragged class. Fix numeric tests. --- massiv-test/src/Test/Massiv/Array/Numeric.hs | 8 +- massiv/CHANGELOG.md | 2 + massiv/src/Data/Massiv/Array.hs | 10 +- massiv/src/Data/Massiv/Array/Delayed.hs | 1 + massiv/src/Data/Massiv/Core.hs | 5 +- massiv/src/Data/Massiv/Core/Common.hs | 13 -- massiv/src/Data/Massiv/Core/List.hs | 139 +++++-------------- 7 files changed, 51 insertions(+), 127 deletions(-) diff --git a/massiv-test/src/Test/Massiv/Array/Numeric.hs b/massiv-test/src/Test/Massiv/Array/Numeric.hs index ca8ca9a9..e741eb04 100644 --- a/massiv-test/src/Test/Massiv/Array/Numeric.hs +++ b/massiv-test/src/Test/Massiv/Array/Numeric.hs @@ -125,7 +125,7 @@ prop_Plus f arr e = expectProp $ do let arr' = compute (A.map (applyFun f) arr) arr !+! arr' `shouldBe` compute (A.zipWith (+) arr arr') let Sz2 m n = size arr - when (m /= n) $ + when (m /= n && m * n /= 0) $ arr .+. compute (transpose arr) `shouldThrow` (== SizeMismatchException (size arr) (Sz2 n m)) prop_Minus :: @@ -141,7 +141,7 @@ prop_Minus f arr e = expectProp $ do let arr' = compute (A.map (applyFun f) arr) arr !-! arr' `shouldBe` compute (A.zipWith (-) arr arr') let Sz2 m n = size arr - when (m /= n) $ + when (m /= n && m * n /= 0) $ arr .-. compute (transpose arr) `shouldThrow` (== SizeMismatchException (size arr) (Sz2 n m)) prop_Times :: @@ -157,7 +157,7 @@ prop_Times f arr e = expectProp $ do let arr' = compute (A.map (applyFun f) arr) arr !*! arr' `shouldBe` compute (A.zipWith (*) arr arr') let Sz2 m n = size arr - when (m /= n) $ + when (m /= n && m * n /= 0) $ arr .*. compute (transpose arr) `shouldThrow` (== SizeMismatchException (size arr) (Sz2 n m)) prop_Divide :: @@ -181,7 +181,7 @@ prop_Divide eps f arr e = e /= 0 ==> expectProp $ do unless (A.or (A.zipWith (\x y -> x == 0 && y == 0) arr arr')) $ arr !/! arr' `shouldBe` compute (A.zipWith (/) arr arr') let Sz2 m n = size arr - when (m /= n) $ + when (m /= n && m * n /= 0) $ arr ./. compute (transpose arr) `shouldThrow` (== SizeMismatchException (size arr) (Sz2 n m)) prop_Floating :: diff --git a/massiv/CHANGELOG.md b/massiv/CHANGELOG.md index a71f8f13..0ba6c9c0 100644 --- a/massiv/CHANGELOG.md +++ b/massiv/CHANGELOG.md @@ -50,6 +50,8 @@ * Consolidate `Mutable` into `Manifest` type class and move the `MArray` data family outside of the class. * Make sure empty arrays are always equal, regardless of their size. +* Remove `LN` representation in favor of a standalone `List` newtype wrapper + around lists. # 0.6.1 diff --git a/massiv/src/Data/Massiv/Array.hs b/massiv/src/Data/Massiv/Array.hs index 6f135601..8cd98b79 100644 --- a/massiv/src/Data/Massiv/Array.hs +++ b/massiv/src/Data/Massiv/Array.hs @@ -62,15 +62,15 @@ -- -- Other Array types: -- --- * `L` and `LN` - those types aren't particularly useful on their own, but because of their unique --- ability to be converted to and from nested lists in constant time, provide a perfect --- intermediary for lists \<-> array conversion. +-- * `L` - this type isn't particularly useful on its own, but because it has unique ability to be +-- converted to and from nested lists in constant time, it provides a perfect intermediary for +-- conversion of nested lists into manifest arrays. -- -- Most of the `Manifest` arrays are capable of in-place mutation. Check out -- "Data.Massiv.Array.Mutable" module for available functionality. -- --- Many of the function names exported by this package will clash with the ones --- from "Prelude", hence it can be more convenient to import like this: +-- Many of the function names exported by this package will clash with the ones from "Prelude", +-- hence it can be more convenient to import like this: -- -- @ -- import Prelude as P diff --git a/massiv/src/Data/Massiv/Array/Delayed.hs b/massiv/src/Data/Massiv/Array/Delayed.hs index 4a488dc9..cc72a38c 100644 --- a/massiv/src/Data/Massiv/Array/Delayed.hs +++ b/massiv/src/Data/Massiv/Array/Delayed.hs @@ -11,6 +11,7 @@ module Data.Massiv.Array.Delayed -- ** Delayed Pull Array D(..) , delay + , liftArray2' , liftArray2M -- ** Delayed Push Array , DL(..) diff --git a/massiv/src/Data/Massiv/Core.hs b/massiv/src/Data/Massiv/Core.hs index 5fe6db61..2571ddf7 100644 --- a/massiv/src/Data/Massiv/Core.hs +++ b/massiv/src/Data/Massiv/Core.hs @@ -7,12 +7,12 @@ -- Portability : non-portable -- module Data.Massiv.Core - ( Array(List, unList) + ( Array(LArray) + , List(..) , Vector , MVector , Matrix , MMatrix - , Elt , Load(iterArrayLinearST_, iterArrayLinearWithSetST_) , Stream(..) , Source @@ -24,7 +24,6 @@ module Data.Massiv.Core , Mutable , Ragged , L(..) - , LN , ListItem , Scheduler , SchedulerWS diff --git a/massiv/src/Data/Massiv/Core/Common.hs b/massiv/src/Data/Massiv/Core/Common.hs index ab82f496..cfec2239 100644 --- a/massiv/src/Data/Massiv/Core/Common.hs +++ b/massiv/src/Data/Massiv/Core/Common.hs @@ -22,7 +22,6 @@ module Data.Massiv.Core.Common , MArray , MVector , MMatrix - , Elt , Steps(..) , Stream(..) , Strategy(..) @@ -151,12 +150,6 @@ type MVector s r e = MArray s r Ix1 e type MMatrix s r e = MArray s r Ix2 e - -type family Elt r ix e :: Type where - Elt r Ix1 e = e - Elt r ix e = Array r (Lower ix) e - - class Load r ix e => Stream r ix e where toStream :: Array r ix e -> Steps Id e @@ -725,12 +718,6 @@ unsafeLinearSwap !marr !i1 !i2 = do class (IsList (Array r ix e), Load r ix e) => Ragged r ix e where - emptyR :: Comp -> Array r ix e - - consR :: Elt r ix e -> Array r ix e -> Array r ix e - - unconsR :: Array r ix e -> Maybe (Elt r ix e, Array r ix e) - generateRaggedM :: Monad m => Comp -> Sz ix -> (ix -> m e) -> m (Array r ix e) flattenRagged :: Array r ix e -> Vector r e diff --git a/massiv/src/Data/Massiv/Core/List.hs b/massiv/src/Data/Massiv/Core/List.hs index dee4d9aa..485dba9c 100644 --- a/massiv/src/Data/Massiv/Core/List.hs +++ b/massiv/src/Data/Massiv/Core/List.hs @@ -20,9 +20,9 @@ -- Portability : non-portable -- module Data.Massiv.Core.List - ( LN - , L(..) + ( L(..) , Array(..) + , List(..) , toListArray , showsArrayPrec , showArrayList @@ -43,18 +43,20 @@ import GHC.Exts import GHC.TypeLits import System.IO.Unsafe (unsafePerformIO) -data LN type family ListItem ix e :: Type where ListItem Ix1 e = e ListItem ix e = [ListItem (Lower ix) e] -newtype instance Array LN ix e = List { unList :: [Elt LN ix e] } +type family Elt ix e :: Type where + Elt Ix1 e = e + Elt ix e = List (Lower ix) e +newtype List ix e = List { unList :: [Elt ix e] } -instance Coercible (Elt LN ix e) (ListItem ix e) => IsList (Array LN ix e) where - type Item (Array LN ix e) = ListItem ix e +instance Coercible (Elt ix e) (ListItem ix e) => IsList (List ix e) where + type Item (List ix e) = ListItem ix e fromList = coerce {-# INLINE fromList #-} toList = coerce @@ -64,11 +66,11 @@ instance Coercible (Elt LN ix e) (ListItem ix e) => IsList (Array LN ix e) where data L = L data instance Array L ix e = LArray { lComp :: Comp - , lData :: !(Array LN ix e) + , lData :: !(List ix e) } -instance Coercible (Elt LN ix e) (ListItem ix e) => IsList (Array L ix e) where +instance Coercible (Elt ix e) (ListItem ix e) => IsList (Array L ix e) where type Item (Array L ix e) = ListItem ix e fromList = LArray Seq . coerce {-# INLINE fromList #-} @@ -82,71 +84,40 @@ lengthHintList = _ -> LengthUnknown {-# INLINE lengthHintList #-} -instance Shape LN Ix1 where - linearSize = SafeSz . length . unList - {-# INLINE linearSize #-} - linearSizeHint = lengthHintList . unList - {-# INLINE linearSizeHint #-} - isNull = null . unList - {-# INLINE isNull #-} - outerSize = linearSize - {-# INLINE outerSize #-} - instance Shape L Ix1 where - linearSize = linearSize . lData + linearSize = outerLength {-# INLINE linearSize #-} - linearSizeHint = linearSizeHint . lData + linearSizeHint = lengthHintList . unList . lData {-# INLINE linearSizeHint #-} - isNull = isNull . lData + isNull = null . unList . lData {-# INLINE isNull #-} outerSize = linearSize {-# INLINE outerSize #-} -instance Shape LN Ix2 where - linearSize = SafeSz . getSum . foldMap (Sum . length . unList) . unList +instance Shape L Ix2 where + linearSize = SafeSz . getSum . foldMap (Sum . length . unList) . unList . lData {-# INLINE linearSize #-} - linearSizeHint = lengthHintList . unList + linearSizeHint = lengthHintList . unList . lData {-# INLINE linearSizeHint #-} - isNull = getAll . foldMap (All . null . unList) . unList + isNull = getAll . foldMap (All . null . unList) . unList . lData {-# INLINE isNull #-} outerSize arr = - case unList arr of + case unList (lData arr) of [] -> zeroSz (x:xs) -> SafeSz ((1 + length xs) :. length (unList x)) {-# INLINE outerSize #-} -instance Shape L Ix2 where - linearSize = linearSize . lData - {-# INLINE linearSize #-} - linearSizeHint = linearSizeHint . lData - {-# INLINE linearSizeHint #-} - isNull = isNull . lData - {-# INLINE isNull #-} - outerSize = outerSize . lData - {-# INLINE outerSize #-} - -instance (Shape LN (Ix (n - 1)), Index (IxN n)) => Shape LN (IxN n) where - linearSize = SafeSz . getSum . foldMap (Sum . unSz . linearSize) . unList +instance (Shape L (Ix (n - 1)), Index (IxN n)) => Shape L (IxN n) where + linearSize = SafeSz . getSum . foldMap (Sum . unSz . linearSize . LArray Seq) . unList . lData {-# INLINE linearSize #-} - linearSizeHint = lengthHintList . unList + linearSizeHint = lengthHintList . unList . lData {-# INLINE linearSizeHint #-} - isNull = getAll . foldMap (All . isNull) . unList + isNull = getAll . foldMap (All . isNull . LArray Seq) . unList . lData {-# INLINE isNull #-} outerSize arr = - case unList arr of + case unList (lData arr) of [] -> zeroSz - (x:xs) -> SafeSz ((1 + length xs) :> unSz (outerSize x)) - {-# INLINE outerSize #-} - - -instance (Index (IxN n), Shape LN (IxN n)) => Shape L (IxN n) where - linearSize = linearSize . lData - {-# INLINE linearSize #-} - linearSizeHint = linearSizeHint . lData - {-# INLINE linearSizeHint #-} - isNull = isNull . lData - {-# INLINE isNull #-} - outerSize = outerSize . lData + (x:xs) -> SafeSz ((1 + length xs) :> unSz (outerSize (LArray Seq x))) {-# INLINE outerSize #-} @@ -155,15 +126,6 @@ outerLength = SafeSz . length . unList . lData instance Ragged L Ix1 e where - emptyR comp = LArray comp (List []) - {-# INLINE emptyR #-} - consR x arr = arr {lData = coerce (x : coerce (lData arr))} - {-# INLINE consR #-} - unconsR LArray {..} = - case L.uncons $ coerce lData of - Nothing -> Nothing - Just (x, xs) -> Just (x, LArray lComp (coerce xs)) - {-# INLINE unconsR #-} flattenRagged = id {-# INLINE flattenRagged #-} generateRaggedM !comp !k f = do @@ -192,20 +154,6 @@ instance (Shape L ix, Ragged L ix e) => Load L ix e where {-# INLINE iterArrayLinearST_ #-} instance Ragged L Ix2 e where - emptyR comp = LArray comp (List []) - {-# INLINE emptyR #-} - consR (LArray _ x) arr = newArr - where - newArr = arr {lData = coerce (x : coerce (lData arr))} - {-# INLINE consR #-} - unconsR LArray {..} = - case L.uncons (coerce lData) of - Nothing -> Nothing - Just (x, xs) -> - let newArr = LArray lComp (coerce xs) - newX = LArray lComp x - in Just (newX, newArr) - {-# INLINE unconsR #-} generateRaggedM = unsafeGenerateParM {-# INLINE generateRaggedM #-} flattenRagged arr = LArray {lComp = lComp arr, lData = coerce xs} @@ -236,25 +184,10 @@ instance Ragged L Ix2 e where showN (\s y -> raggedFormat f s (LArray comp y :: Array L Ix1 e)) sep (coerce xs) instance ( Shape L (IxN n) - , Shape LN (Ix (n - 1)) , Ragged L (Ix (n - 1)) e - , Coercible (Elt LN (Ix (n - 1)) e) (ListItem (Ix (n - 1)) e) + , Coercible (Elt (Ix (n - 1)) e) (ListItem (Ix (n - 1)) e) ) => Ragged L (IxN n) e where - emptyR comp = LArray comp (List []) - {-# INLINE emptyR #-} - consR (LArray _ x) arr = newArr - where - newArr = arr {lData = coerce (x : coerce (lData arr))} - {-# INLINE consR #-} - unconsR LArray {..} = - case L.uncons (coerce lData) of - Nothing -> Nothing - Just (x, xs) -> - let newArr = LArray lComp (coerce xs) - newX = LArray lComp x - in Just (newX, newArr) - {-# INLINE unconsR #-} generateRaggedM = unsafeGenerateParM {-# INLINE generateRaggedM #-} flattenRagged arr = LArray {lComp = lComp arr, lData = coerce xs} @@ -270,18 +203,20 @@ instance ( Shape L (IxN n) | end - start < numWorkers scheduler * step = scheduler | otherwise = trivialScheduler_ leftOver <- - loopM start (< end) (+ step) xs $ \i zs -> - case unconsR zs of - Nothing -> throwM (DimTooShortException (dimensions sz) k (outerLength xs)) - Just (y, ys) -> - ys <$ scheduleWork_ scheduler (loadRaggedST subScheduler y uWrite i (i + step) szL) - unless (isNull leftOver) $ throwM $ DimTooLongException (dimensions sz) k (outerLength xs) + loopM start (< end) (+ step) (unList (lData xs)) $ \i zs -> + case zs of + [] -> throwM (DimTooShortException (dimensions sz) k (outerLength xs)) + (y:ys) -> do + scheduleWork_ scheduler $ + loadRaggedST subScheduler (LArray Seq y) uWrite i (i + step) szL + pure ys + unless (null leftOver) $ throwM $ DimTooLongException (dimensions sz) k (outerLength xs) {-# INLINE loadRaggedST #-} raggedFormat f sep (LArray comp xs) = showN (\s y -> raggedFormat f s (LArray comp y :: Array L (Ix (n - 1)) e)) sep (coerce xs) unsafeGenerateParM :: - (Elt LN ix e ~ Array LN (Lower ix) e, Index ix, Monad m, Ragged L (Lower ix) e) + (Elt ix e ~ List (Lower ix) e, Index ix, Monad m, Ragged L (Lower ix) e) => Comp -> Sz ix -> (ix -> m e) @@ -341,9 +276,9 @@ toListArray !arr = makeArray (getComp arr) (outerSize arr) (unsafeIndex arr) instance (Ragged L ix e, Show e) => Show (Array L ix e) where showsPrec n arr = showsArrayLAsPrec (Proxy :: Proxy L) (outerSize arr) n arr -instance (Ragged L ix e, Show e) => Show (Array LN ix e) where - show arr = " " ++ raggedFormat show "\n " arrL - where arrL = LArray Seq arr :: Array L ix e +instance (Ragged L ix e, Show e) => Show (List ix e) where + show xs = " " ++ raggedFormat show "\n " arrL + where arrL = LArray Seq xs :: Array L ix e showN :: (String -> a -> String) -> String -> [a] -> String From 8da4d4ecf3bdd4ccabb89ec89609bba8bf45d40e Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Fri, 30 Jul 2021 03:39:06 +0300 Subject: [PATCH 62/65] IsList instance for Steps. Minor doc improvemnets --- Quickref.md | 24 ++++++------------- massiv-bench/bench/Mutable.hs | 2 +- massiv-test/README.md | 2 +- .../src/Data/Massiv/Array/Delayed/Stream.hs | 12 +++++----- massiv/src/Data/Massiv/Vector/Stream.hs | 16 ++++++++++--- 5 files changed, 28 insertions(+), 28 deletions(-) diff --git a/Quickref.md b/Quickref.md index bdb0fdf5..f287d249 100644 --- a/Quickref.md +++ b/Quickref.md @@ -5,9 +5,9 @@ Everyone is well accustomed to the fact that the order of indices corresponds to the number of dimensions an array can have in the reverse order, eg in `C`: `arr[i][j][k]` will mean that a 3-dimensional array is indexed at an outer most 3rd dimension with index `i`, 2nd dimension `j` and -the inner most 1st dimension `k`. In case of a 3d world `i` points to a page, `j` to a column and -`k` to the row, but the astraction scales pretty well to any dimension as long as we agree on the -order of things. Below are two ways to index an array in massiv: +the inner most 1st dimension `k`. In case of a 3d world `i` points to a page, `j` to a row and +`k` to a column, but the astraction scales pretty well to any dimension as long as we agree on the +order of things. Below are various ways to index an array in massiv: ```haskell λ> arr = makeArrayR U Seq (Sz (2 :> 3 :. 4)) $ \ (i :> j :. k) -> i + j ^ k @@ -20,8 +20,8 @@ order of things. Below are two ways to index an array in massiv: 9 ``` -Former does the lookup of an element in the array, while the latter slices the array until it gets to -the actual element. +Former does the lookup of an element in the array, while the latter slices the +array until it gets to a a row and only then looks up the actual element. Data is represented in a linear row-major fashion, so the above indexing technique translates into a linear index that will get mapped into an element in @@ -36,18 +36,8 @@ memory at some point. Size (D, DL, DI, B, BN, BL, P, U, S) Shape (D, DL, DS, DI, DW, B, BN, BL, P, U, S, L, LN) StrideLoad (DI, DW) -> Load (DL, DS, L) -> Source (D) -> Manifest (B, BN, BL, P, U, S) - |\ - | `> Extract (D, DS, DI, B, BN, BL, P, U, S) - |\ - | `> Slice (D, B, BN, BL, P, U, S) - |\ - | `> OuterSlice (D, B, BN, BL, P, U, S, L) - \ - `> InnerSlice (D, B, BN, BL, P, U, S) - -Stream (D, DS, B, BN, BL, P, U, S, L, LN) - -Resize (D, DL, DI, B, BN, BL, P, U, S) + \ + `-> Stream (D, B, BN, BL, P, U, S, L) ``` ## Computation diff --git a/massiv-bench/bench/Mutable.hs b/massiv-bench/bench/Mutable.hs index 18ec67d7..d0d79484 100644 --- a/massiv-bench/bench/Mutable.hs +++ b/massiv-bench/bench/Mutable.hs @@ -20,7 +20,7 @@ main = do mkBench :: - forall r. (Load r Ix2 Double, Mutable r Double) + forall r. (Load r Ix2 Double, Manifest r Double) => Sz2 -> r -> IO [Benchmark] diff --git a/massiv-test/README.md b/massiv-test/README.md index 248ef590..e73fcbac 100644 --- a/massiv-test/README.md +++ b/massiv-test/README.md @@ -16,7 +16,7 @@ on `massiv`. Another important use case is for advanced users that came up with their own index types or array representations and would like to run a standard set of specs on their instance -implementations. For example a custom `Index ix`, or `Mutable r ix e` instances can use a +implementations. For example a custom `Index ix`, or `Maniest r e` instances can use a predefined collection of `hspec` specs and/or `QuickCheck` properties to validate their implementation. diff --git a/massiv/src/Data/Massiv/Array/Delayed/Stream.hs b/massiv/src/Data/Massiv/Array/Delayed/Stream.hs index 8f1a247f..5a31a033 100644 --- a/massiv/src/Data/Massiv/Array/Delayed/Stream.hs +++ b/massiv/src/Data/Massiv/Array/Delayed/Stream.hs @@ -44,21 +44,21 @@ newtype instance Array DS Ix1 e = DSArray -- | /O(1)/ - Convert delayed stream array into `Steps`. -- -- @since 0.4.1 -toSteps :: Array DS Ix1 e -> Steps Id e +toSteps :: Vector DS e -> Steps Id e toSteps = coerce {-# INLINE toSteps #-} -- | /O(1)/ - Convert `Steps` into delayed stream array -- -- @since 0.4.1 -fromSteps :: Steps Id e -> Array DS Ix1 e +fromSteps :: Steps Id e -> Vector DS e fromSteps = coerce {-# INLINE fromSteps #-} -- | /O(1)/ - Convert monadic `Steps` into delayed stream array -- -- @since 0.5.0 -fromStepsM :: Monad m => Steps m e -> m (Array DS Ix1 e) +fromStepsM :: Monad m => Steps m e -> m (Vector DS e) fromStepsM = fmap DSArray . S.transSteps {-# INLINE fromStepsM #-} @@ -146,9 +146,9 @@ instance Monoid (Array DS Ix1 e) where instance IsList (Array DS Ix1 e) where type Item (Array DS Ix1 e) = e - fromList = fromSteps . S.fromList + fromList = fromSteps . fromList {-# INLINE fromList #-} - fromListN n = fromSteps . S.fromListN n + fromListN n = fromSteps . fromListN n {-# INLINE fromListN #-} toList = S.toList . coerce {-# INLINE toList #-} @@ -164,7 +164,7 @@ instance S.Stream DS Ix1 e where -- | Flatten an array into a stream of values. -- -- @since 0.4.1 -toStreamArray :: (Index ix, Source r e) => Array r ix e -> Array DS Ix1 e +toStreamArray :: (Index ix, Source r e) => Array r ix e -> Vector DS e toStreamArray = DSArray . S.steps {-# INLINE[1] toStreamArray #-} {-# RULES "toStreamArray/id" toStreamArray = id #-} diff --git a/massiv/src/Data/Massiv/Vector/Stream.hs b/massiv/src/Data/Massiv/Vector/Stream.hs index c1debb6b..7f160e4e 100644 --- a/massiv/src/Data/Massiv/Vector/Stream.hs +++ b/massiv/src/Data/Massiv/Vector/Stream.hs @@ -4,10 +4,11 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TupleSections #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# OPTIONS_HADDOCK hide, not-home #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_HADDOCK hide, not-home #-} -- | -- Module : Data.Massiv.Vector.Stream -- Copyright : (c) Alexey Kuleshevich 2019-2021 @@ -143,7 +144,7 @@ import Data.Vector.Fusion.Util import Prelude hiding (and, concatMap, drop, filter, foldl, foldl1, foldr, foldr1, length, map, mapM, mapM_, null, or, replicate, take, traverse, zipWith, zipWith3) - +import qualified GHC.Exts (IsList(..)) instance Monad m => Functor (Steps m) where fmap f str = str {stepsStream = S.map f (stepsStream str)} @@ -165,6 +166,15 @@ instance Monad m => Monoid (Steps m e) where {-# INLINE mappend #-} +instance GHC.Exts.IsList (Steps Id e) where + type Item (Steps Id e) = e + toList = toList + {-# INLINE toList #-} + fromList = fromList + {-# INLINE fromList #-} + fromListN n = (`Steps` LengthMax (Sz n)) . S.fromListN n + {-# INLINE fromListN #-} + instance Foldable (Steps Id) where foldr f acc = unId . foldrLazy f acc {-# INLINE foldr #-} From 75e56b7af5974a95f72761ec63b5441baf8579f4 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Fri, 30 Jul 2021 16:26:03 +0300 Subject: [PATCH 63/65] Remove debug info on CI and reorder back the tests --- .github/workflows/haskell.yml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index adf3af84..f6d32f1a 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -118,15 +118,14 @@ jobs: set -ex [ -n "${{ matrix.ghc }}" ] && [ "${{ matrix.os }}" == "ubuntu-latest" ] && STACK_ARGS="$STACK_ARGS --system-ghc" [ -n "${{ matrix.stack-yaml }}" ] && STACK_YAML=${{ matrix.stack-yaml }} - echo "${STACK_ARGS}" if [ "${{ matrix.os }}.${{ matrix.resolver }}" == "ubuntu-latest.lts-14" ] && [ -n "${COVERALLS_TOKEN}" ]; then stack $STACK_ARGS test massiv-test:tests --coverage --haddock --no-haddock-deps stack $STACK_ARGS hpc report --all curl -L https://github.com/rubik/stack-hpc-coveralls/releases/download/v0.0.6.1/shc-linux-x64-8.8.4.tar.bz2 | tar xj shc ./shc --repo-token="$COVERALLS_TOKEN" --partial-coverage --fetch-coverage combined custom else - stack $STACK_ARGS test massiv-test:tests stack $STACK_ARGS test massiv:doctests + stack $STACK_ARGS test massiv-test:tests fi massiv-examples: From 66806aa060e9b90a239403ad0abed41bd7daa672 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sat, 31 Jul 2021 19:10:50 +0300 Subject: [PATCH 64/65] Improve Readme. Haddock and doctest improvements. Export array constructors from unsafe module --- .gitignore | 1 + Quickref.md | 19 +- README.md | 601 +--------------- massiv-bench/bench/{Sum.hs => Fold.hs} | 2 +- massiv-bench/bench/Sobel.hs | 20 +- massiv-bench/massiv-bench.cabal | 23 +- massiv-bench/src/Data/Massiv/Bench.hs | 33 - massiv-bench/src/Data/Massiv/Bench/Common.hs | 29 + massiv-bench/src/Data/Massiv/Bench/Sobel.hs | 26 +- massiv-examples/vision/app/AvgSum.hs | 28 +- massiv-examples/vision/stack.yaml | 13 - massiv/README.md | 668 +++++++++++++++++- massiv/massiv.cabal | 1 + .../Data/Massiv/Array/Delayed/Interleaved.hs | 1 + .../src/Data/Massiv/Array/Manifest/Boxed.hs | 1 + massiv/src/Data/Massiv/Array/Manifest/List.hs | 14 +- .../Data/Massiv/Array/Manifest/Primitive.hs | 1 + .../Data/Massiv/Array/Manifest/Storable.hs | 1 + .../src/Data/Massiv/Array/Manifest/Unboxed.hs | 1 + massiv/src/Data/Massiv/Array/Ops/Construct.hs | 3 +- massiv/src/Data/Massiv/Array/Ops/Map.hs | 6 +- massiv/src/Data/Massiv/Array/Ops/Transform.hs | 78 +- massiv/src/Data/Massiv/Array/Unsafe.hs | 17 +- massiv/src/Data/Massiv/Core.hs | 2 + massiv/src/Data/Massiv/Core/Common.hs | 9 +- massiv/src/Data/Massiv/Core/Index/Internal.hs | 2 +- 26 files changed, 864 insertions(+), 736 deletions(-) mode change 100644 => 120000 README.md rename massiv-bench/bench/{Sum.hs => Fold.hs} (98%) delete mode 100644 massiv-examples/vision/stack.yaml diff --git a/.gitignore b/.gitignore index eb3eed30..2a139bff 100644 --- a/.gitignore +++ b/.gitignore @@ -18,3 +18,4 @@ cabal.sandbox.config .stack-work* cabal.project.local bench-*.html +massiv-examples/files/* diff --git a/Quickref.md b/Quickref.md index f287d249..7efd6997 100644 --- a/Quickref.md +++ b/Quickref.md @@ -4,9 +4,9 @@ Everyone is well accustomed to the fact that the order of indices corresponds to the number of dimensions an array can have in the reverse order, eg in `C`: `arr[i][j][k]` will mean that a -3-dimensional array is indexed at an outer most 3rd dimension with index `i`, 2nd dimension `j` and -the inner most 1st dimension `k`. In case of a 3d world `i` points to a page, `j` to a row and -`k` to a column, but the astraction scales pretty well to any dimension as long as we agree on the +3-dimensional array is indexed at an outermost 3rd dimension with index `i`, 2nd dimension `j` and +the innermost 1st dimension `k`. In the case of a 3D world `i` points to a page, `j` to a row and +`k` to a column, but the astraction scales naturally to any dimension as long as we agree on the order of things. Below are various ways to index an array in massiv: ```haskell @@ -20,12 +20,11 @@ order of things. Below are various ways to index an array in massiv: 9 ``` -Former does the lookup of an element in the array, while the latter slices the -array until it gets to a a row and only then looks up the actual element. +Former does the lookup of an element in the array, while the latter slices the array until it gets +to a row and only then looks up the actual element. -Data is represented in a linear row-major fashion, so the above indexing -technique translates into a linear index that will get mapped into an element in -memory at some point. +Data is represented in a linear row-major fashion, so the above indexing technique translates into a +linear index that will get mapped into an element in memory at some point. ## Hierarchy @@ -49,7 +48,7 @@ to that: construction or conversion, eg. from a list or vector * array computation strategy will be combined according to its `Monoid` instance when two or more arrays are being joined together by some operation into another one. -* Most of functions will respect the inner computation strategy, while others will ignore it due to +* Most functions will respect the inner computation strategy, while others will ignore it due to their specific nature. ## Naming Conventions @@ -93,7 +92,7 @@ argument. Functions with the `Inner` suffix use dimension `1`. ### Conversion from `array` Here is an example of how to convert a nested boxed array from `array` package to a -rectangular `Matrix` with parallellization: +rectangular `Matrix` with parallelization: ```haskell diff --git a/README.md b/README.md deleted file mode 100644 index 02fbaacf..00000000 --- a/README.md +++ /dev/null @@ -1,600 +0,0 @@ -# massiv - -`massiv` is a Haskell library for array manipulation. Performance is one of its main goals, thus it -is capable of seamless parallelization of almost all of operations. - -The name for this library comes from the Russian word Massiv (Масси́в), which means an Array. - -## Status - -| Language | Github Actions | Azure | Coveralls |Gitter.im | -|:--------:|:--------------:|:--------:|:---------:|:--------:| -| ![GitHub top language](https://img.shields.io/github/languages/top/lehins/massiv.svg) | [![Build Status](https://github.com/lehins/massiv/workflows/massiv-CI/badge.svg)](https://github.com/lehins/massiv/actions) | [![Build Status](https://dev.azure.com/kuleshevich/massiv/_apis/build/status/lehins.massiv?branchName=master)](https://dev.azure.com/kuleshevich/massiv/_build?branchName=master) | [![Coverage Status](https://coveralls.io/repos/github/lehins/massiv/badge.svg?branch=master)](https://coveralls.io/github/lehins/massiv?branch=master) | [![Join the chat at https://gitter.im/haskell-massiv/Lobby](https://badges.gitter.im/haskell-massiv/Lobby.svg)](https://gitter.im/haskell-massiv/Lobby?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) - -| Package | Hackage | Nightly | LTS | -|:-------------------|:-------:|:-------:|:---:| -| [`massiv`](https://github.com/lehins/massiv/tree/master/massiv)| [![Hackage](https://img.shields.io/hackage/v/massiv.svg)](https://hackage.haskell.org/package/massiv)| [![Nightly](https://www.stackage.org/package/massiv/badge/nightly)](https://www.stackage.org/nightly/package/massiv)| [![Nightly](https://www.stackage.org/package/massiv/badge/lts)](https://www.stackage.org/lts/package/massiv)| -| [`massiv-io`](https://github.com/lehins/massiv-io)| [![Hackage](https://img.shields.io/hackage/v/massiv-io.svg)](https://hackage.haskell.org/package/massiv-io)| [![Nightly](https://www.stackage.org/package/massiv-io/badge/nightly)](https://www.stackage.org/nightly/package/massiv-io)| [![Nightly](https://www.stackage.org/package/massiv-io/badge/lts)](https://www.stackage.org/lts/package/massiv-io)| -| [`massiv-test`](https://github.com/lehins/massiv/tree/master/massiv-test)| [![Hackage](https://img.shields.io/hackage/v/massiv-test.svg)](https://hackage.haskell.org/package/massiv-test)| [![Nightly](https://www.stackage.org/package/massiv-test/badge/nightly)](https://www.stackage.org/nightly/package/massiv-test)| [![Nightly](https://www.stackage.org/package/massiv-test/badge/lts)](https://www.stackage.org/lts/package/massiv-test)| -| [`haskell-scheduler`](https://github.com/lehins/haskell-scheduler)| [![Hackage](https://img.shields.io/hackage/v/scheduler.svg)](https://hackage.haskell.org/package/scheduler)| [![Nightly](https://www.stackage.org/package/scheduler/badge/nightly)](https://www.stackage.org/nightly/package/scheduler)| [![Nightly](https://www.stackage.org/package/scheduler/badge/lts)](https://www.stackage.org/lts/package/scheduler)| - -## Introduction - -Everything in the library revolves around an `Array r ix e` - a data type -family for anything that can be thought of as an array. The type variables, -from the end, are: - -* `e` - element of an array. -* `ix` - an index that will map to an actual element. The index must be an instance of the `Index` class - with the default one being an `Ix n` type family and an optional being tuples of `Int`s. -* `r` - underlying representation. The main representations are: - - * `D` - delayed array, which is simply a function from an index to an element: `(ix -> - e)`. Therefore indexing of this type of array is not possible, although elements can be - computed with the `evaluateAt` function. - * A few more extravagant delayed arrays, which are described in more depth in haddock: `DI`, `DL` - and `DW` - * `P` - Array with elements that are an instance of `Prim` type class, i.e. common Haskell - primitive types: `Int`, `Word`, `Char`, etc. Backed by the usual `ByteArray`. - * `U` - Unboxed arrays. The elements are instances of the `Unbox` type class. Just as fast as - `P`, but has a wider range of data types that it can work with. Notable data types that can be - stored as elements are `Bool`, tuples and `Ix n`. - * `S` - Storable arrays. Backed by a pinned `ByteArray`s and elements are instances of the - `Storable` type class. - * `B` - Boxed arrays that don't have restrictions on their elements, since they are represented - as pointers to elements, thus making them the slowest type of array, but also the most - general. Arrays of this representation are element strict, in other words its elements are - kept in Weak-Head Normal Form (WHNF). - * `N` - Also boxed arrays, but unlike the other representation `B`, its elements are in Normal - Form, i.e. in a fully evaluated state and no thunks or memory leaks are possible. It does - require `NFData` instance for the elements though. - -## Construct - -Creating a delayed type of array allows us to fuse any future operation we decide to perform on -it. Let's look at this example: - -```haskell -λ> import Data.Massiv.Array as A -λ> makeVectorR D Seq 10 id -Array D Seq (Sz1 10) - [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9 ] -``` - -Here we created a delayed vector of size 10, which is in reality just an `id` function from its -index to an element (see the [Computation](#computation) section for the meaning of `Seq`). So let's -go ahead and square its elements - -```haskell -λ> vec = makeVectorR D Seq 10 id -λ> evaluate' vec 4 -4 -λ> vec2 = A.map (^ (2::Int)) vec -λ> evaluate' vec2 4 -16 -``` - -It's not that exciting, since every time we call `evaluate'` it will recompute the element, __every -time__, therefore this function should be avoided at all costs. Instead we can use all of the -functions that take `Source` like arrays and then fuse that computation together by calling -`compute`, or a handy `computeAs` function and only afterwards apply an `index'` function or its -synonym: `(!)`. Any delayed array can also be reduced using one of the folding functions, thus -completely avoiding any memory allocation, or converted to a list, if that's what you need: - -```haskell -λ> vec2U = computeAs U vec2 -λ> vec2U -Array U Seq (Sz1 10) - [ 0, 1, 4, 9, 16, 25, 36, 49, 64, 81 ] -λ> vec2U ! 4 -16 -λ> toList vec2U -[0,1,4,9,16,25,36,49,64,81] -λ> A.sum vec2U -285 -``` - -There is a whole multitude of ways to construct arrays: - * by using one of many helper functions: `makeArray`, `range`, `rangeStepFrom`, `enumFromN`, etc. - * through conversion: from lists, from `Vector`s in `vector` library, from `ByteString`s in - `bytestring`; - * with a help of mutable interface in `PrimMonad` (`IO`, `ST`, etc.), eg: `makeMArray`, - `generateArray`, `unfoldrPrim`, etc. - -It's worth noting that, in the next example, nested lists will be loaded into an unboxed manifest -array and the sum of its elements will be computed in parallel on all available cores. - -```haskell -λ> A.sum (fromLists' Par [[0,0,0,0,0],[0,1,2,3,4],[0,2,4,6,8]] :: Array U Ix2 Double) -30.0 -``` - -The above wouldn't run in parallel in ghci of course, as the program would have to be compiled with -`ghc` using `-threaded -with-rtsopts=-N` flags in order to use all available cores. Alternatively we -could do compile with the `-threaded` flag and then pass the number of capabilities directly to the -runtime with `+RTS -N`, where `` is the number of cores you'd like to utilize. - -## Index - -The main `Ix n` closed type family can be somewhat confusing, but there is no need to fully -understand how it works in order to start using it. GHC might ask you for the `DataKinds` language -extension if `IxN n` is used in a type signature, but there are type and pattern synonyms for the -first five dimensions: `Ix1`, `Ix2`, `Ix3`, `Ix4` and `Ix5`. - -There are three distinguishable constructors for the index: - -* The first one is simply an int: `Ix1 = Ix 1 = Int`, therefore vectors can be indexed in a usual way - without some extra wrapping data type, just as it was demonstrated in a previous section. -* The second one is `Ix2` for operating on 2-dimensional arrays and has a constructor `:.` - -```haskell -λ> makeArrayR D Seq (Sz (3 :. 5)) (\ (i :. j) -> i * j) -Array D Seq (Sz (3 :. 5)) - [ [ 0, 0, 0, 0, 0 ] - , [ 0, 1, 2, 3, 4 ] - , [ 0, 2, 4, 6, 8 ] - ] -``` - -* The third one is `IxN n` and is designed for working with N-dimensional arrays, and has a similar - looking constructor `:>`, except that it can be chained indefinitely on top of `:.` - -```haskell -λ> arr3 = makeArrayR D Seq (Sz (3 :> 2 :. 5)) (\ (i :> j :. k) -> i * j + k) -λ> :t arr3 -arr3 :: Array D (IxN 3) Int -λ> arr3 -Array D Seq (Sz (3 :> 2 :. 5)) - [ [ [ 0, 1, 2, 3, 4 ] - , [ 0, 1, 2, 3, 4 ] - ] - , [ [ 0, 1, 2, 3, 4 ] - , [ 1, 2, 3, 4, 5 ] - ] - , [ [ 0, 1, 2, 3, 4 ] - , [ 2, 3, 4, 5, 6 ] - ] - ] -λ> :t (10 :> 9 :> 8 :> 7 :> 6 :> 5 :> 4 :> 3 :> 2 :. 1) -λ> :t ix10 -ix10 :: IxN 10 -λ> ix10 -- 10-dimensional index -10 :> 9 :> 8 :> 7 :> 6 :> 5 :> 4 :> 3 :> 2 :. 1 -``` - -Here is how we can construct a 4-dimensional array and sum its elements in constant memory: - -```haskell -λ> arr = makeArrayR D Seq (Sz (10 :> 20 :> 30 :. 40)) $ \ (i :> j :> k :. l) -> (i * j + k) * k + l -λ> :t arr -- a 4-dimensional array -arr :: Array D (IxN 4) Int -λ> A.sum arr -221890000 -``` - -There are quite a few helper functions that can operate on indicies, but these are only needed when -writing functions that work for arrays of arbitrary dimension, as such they are scarcely used: - -```haskell -λ> pullOutDim' ix10 5 -(5,10 :> 9 :> 8 :> 7 :> 6 :> 4 :> 3 :> 2 :. 1) -λ> unconsDim ix10 -(10,9 :> 8 :> 7 :> 6 :> 5 :> 4 :> 3 :> 2 :. 1) -λ> unsnocDim ix10 -(10 :> 9 :> 8 :> 7 :> 6 :> 5 :> 4 :> 3 :. 2,1) -``` - -All of the `Ix n` indices are instances of `Num` so basic numeric operations are made easier: - -```haskell -λ> (1 :> 2 :. 3) + (4 :> 5 :. 6) -5 :> 7 :. 9 -λ> 5 :: Ix4 -5 :> 5 :> 5 :. 5 -``` - -It is important to note that the size type is distinct from index by the newtype wrapper `Sz -ix`. There is a constructor `Sz`, which will make sure that none of the dimensions are negative: - -```haskell -λ> Sz (2 :> 3 :. 4) -Sz (2 :> 3 :. 4) -λ> Sz (10 :> 2 :> -30 :. 4) -Sz (10 :> 2 :> 0 :. 4) -``` - -Same as with indicies, there are helper pattern synonyms: `Sz1`, `Sz2`, `Sz3`, `Sz4` and `Sz5`. - -```haskell -λ> Sz3 2 3 4 -Sz (2 :> 3 :. 4) -λ> Sz4 10 2 (-30) 4 -Sz (10 :> 2 :> 0 :. 4) -``` - -As well as the `Num` instance: - -```haskell -λ> 4 :: Sz5 -Sz (4 :> 4 :> 4 :> 4 :. 4) -λ> (Sz2 1 2) + 3 -Sz (4 :. 5) -λ> (Sz2 1 2) - 3 -Sz (0 :. 0) -``` - -Alternatively tuples of `Int`s can be used for working with Arrays, up to and including 5-tuples -(type synonyms: `Ix2T` - `Ix5T`), but since tuples are polymorphic it is necessary to restrict the -resulting array type: - -```haskell -λ> makeArray Seq (4, 20) (uncurry (*)) :: Array P Ix2T Int -(Array P Seq ((4,20)) - [ [ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 ] - , [ 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19 ] - , [ 0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38 ] - , [ 0,3,6,9,12,15,18,21,24,27,30,33,36,39,42,45,48,51,54,57 ] - ]) -λ> :i Ix2T -type Ix2T = (Int, Int) -``` - -There are helper functions that can go back and forth between tuples and `Ix n` indices. - -```haskell -λ> fromIx4 (3 :> 4 :> 5 :. 6) -(3,4,5,6) -λ> toIx5 (3, 4, 5, 6, 7) -3 :> 4 :> 5 :> 6 :. 7 -``` - -## Slicing - -In order to get a subsection of an array there is no need to recompute it, unless we want to free up -the no longer memory, of course. So, there are a few slicing, resizing and extraction operators that -can do it all in constant time, modulo the index manipulation: - -```haskell -λ> arr = makeArrayR U Seq (Sz (4 :> 2 :. 6)) fromIx3 -λ> arr !> 3 !> 1 -Array M Seq (Sz1 6) - [ (3,1,0), (3,1,1), (3,1,2), (3,1,3), (3,1,4), (3,1,5) ] -``` - -As you might suspect all of the slicing, indexing, extracting, resizing operations are partial, and -those are frowned upon in Haskell. So there are matching functions that can do the same operations -safely by using `MonadThrow` and thus returning `Nothing`, `Left SomeException` or throwing an -exception in case of `IO` on failure for example - -```haskell -λ> arr !?> 3 ??> 1 -Array M Seq (Sz1 6) - [ (3,1,0), (3,1,1), (3,1,2), (3,1,3), (3,1,4), (3,1,5) ] -λ> arr !?> 3 ??> 1 ??> 0 :: Maybe (Int, Int, Int) -Just (3,1,0) -``` - -In above examples we first take a slice at the 4th page (index 3, since we start at 0), then another -one at the 2nd row (index 1). While in the last example we also take 1st element at -position 0. Pretty neat, huh? Naturally, by doing a slice we always reduce dimension by one. We can -do slicing from the outside as well as from the inside: - -```haskell -λ> 1 ... 10 -Array D Seq (Sz1 10) - [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ] -λ> a <- resizeM (Sz (3 :. 3)) $ 1 ... 10 -λ> a -Array D Seq (Sz (3 :. 3)) - [ [ 1, 2, 3 ] - , [ 4, 5, 6 ] - , [ 7, 8, 9 ] - ] -λ> a !> 0 -Array D Seq (Sz1 3) - [ 1, 2, 3 ] -λ> a -``` - -Or we can slice along any other available dimension: - -```haskell -λ> a (2, 0) -Array D Seq (Sz1 3) - [ 1, 2, 3 ] -λ> a (1, 0) -Array D Seq (Sz1 3) - [ 1, 4, 7 ] -λ> a (1, 2) -Array D Seq (Sz1 3) - [ 3, 6, 9 ] -``` - -In order to extract sub-array while preserving dimensionality we can use `extract` or `extractFromTo`. - -```haskell -λ> extractM 0 (Sz (1 :. 3)) a -Array D Seq (Sz (1 :. 3)) - [ [ 1, 2, 3 ] - ] -λ> extractM 0 (Sz (3 :. 1)) a -Array D Seq (Sz (3 :. 1)) - [ [ 1 ] - , [ 4 ] - , [ 7 ] - ] -``` - -## Computation - -There is a data type `Comp` that controls how elements will be computed when calling the `compute` -function. It has a few constructors, although most of the time either `Seq` or `Par` will be -sufficient: - -* `Seq` - computation will be done sequentially on one core (capability in ghc). -* `ParOn [Int]` - perform computation in parallel while pinning the workers to particular - cores. Providing an empty list will result in the computation being distributed over all - available cores, or better known in Haskell as capabilities. -* `ParN Word16` - similar to `ParOn`, except it simply specifies the number of cores to - use, with `0` meaning all cores. -* `Par` - isn't really a constructor but a `pattern` for constructing `ParOn []`, which - will result in Scheduler using all cores, thus should be used instead of `ParOn`. -* `Par'` - similar to `Par`, except it uses `ParN 0` underneath. - -Just to make sure a simple novice mistake is prevented, which I have seen in the past, make sure -your source code is compiled with `ghc -O2 -threaded -with-rtsopts=-N`, otherwise no parallelization -and poor performance are waiting for you. Also a bit later you might notice the `{-# INLINE funcName -#-}` pragma being used, often times it is a good idea to do that, but not always required. It is -worthwhile to benchmark and experiment. - -## Stencil - -Instead of manually iterating over a multidimensional array and applying a function to each element, -while reading its neighboring elements (as you would do in an imperative language) in a functional -language it is much more efficient to apply a stencil function and let the library take care of all -of bounds checking and iterating in a cache friendly manner. - -What's a [stencil](https://en.wikipedia.org/wiki/Stencil_code)? It is a declarative way of -specifying a pattern for how elements of an array in a neighborhood will be used in order to update -each element of that array. In massiv a `Stencil` is a function that can read the neighboring elements -of the stencil's _center_ (the zero index), and only those, and then outputs a new value for the -center element. - -![stencil](massiv-examples/files/stencil.png) - -Let's create a simple, but somewhat meaningful array and create an averaging -stencil. There is nothing particular about the array itself, but the filter is -a stencil that sums the elements in a [Moore -neighborhood](https://en.wikipedia.org/wiki/Moore_neighborhood) and -divides the result by 9, i.e. finds the average of a 3 by 3 square. - -```haskell -arrLightIx2 :: Comp -> Sz Ix2 -> Array D Ix2 Double -arrLightIx2 comp arrSz = makeArray comp arrSz $ \ (i :. j) -> sin (fromIntegral (i * i + j * j)) -{-# INLINE arrLightIx2 #-} - -average3x3Filter :: (Default a, Fractional a) => Stencil Ix2 a a -average3x3Filter = makeStencil (Sz (3 :. 3)) (1 :. 1) $ \ get -> - ( get (-1 :. -1) + get (-1 :. 0) + get (-1 :. 1) + - get ( 0 :. -1) + get ( 0 :. 0) + get ( 0 :. 1) + - get ( 1 :. -1) + get ( 1 :. 0) + get ( 1 :. 1) ) / 9 -{-# INLINE average3x3Filter #-} -``` - -Here is what it would look like in GHCi. We create a delayed array with some funky periodic -function, and make sure it is computed prior to mapping an average stencil over it: - -```haskell -λ> arr = computeAs U $ arrLightIx2 Par (Sz (600 :. 800)) -λ> :t arr -arr :: Array U Ix2 Double -λ> :t mapStencil Edge average3x3Filter arr -mapStencil Edge average3x3Filter arr :: Array DW Ix2 Double -``` - -As you can see, that operation produced an array of some weird representation `DW`, which stands for -Delayed Windowed array. In its essence `DW` is an array type that does no bounds checking in order -to gain performance, except when it's near the border, where it uses a border resolution technique -supplied by the user (`Edge` in the example above). Currently it is used only in stencils and -not much else can be done to an array of this type besides further computing it into a -manifest representation. - -This example will be continued in the next section, but before that I would like to mention that -some might notice that it looks very much like convolution, and in fact convolution can be -implemented with a stencil. There is a helper function `makeConvolutionStencil` that lets -you do just that. For the sake of example we'll do a sum of all neighbors by hand instead: - -```haskell -sum3x3Filter :: Fractional a => Stencil Ix2 a a -sum3x3Filter = makeConvolutionStencil (Sz (3 :. 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 -{-# INLINE sum3x3Filter #-} -``` - -There is not a single plus or multiplication sign, that is because convolutions is actually -summation of elements multiplied by a kernel element, so instead we have composition of functions -applied to an offset index and a multiplier. After we map that stencil, we can further divide each -element of the array by 9 in order to get the average. Yeah, I lied a bit, `Array DW ix` is an -instance of `Functor` class, so we can map functions over it, which will be fused as with a regular -`D`elayed array: - -```haskell -computeAs U $ fmap (/9) $ mapStencil Edge sum3x3Filter arr -``` - -If you are still confused of what a stencil is, but you are familiar with [Conway's Game of -Life](https://en.wikipedia.org/wiki/Conway%27s_Game_of_Life) this should hopefully clarify it a -bit more. The function `life` below is a single iteration of Game of Life: - -```haskell -lifeRules :: Word8 -> Word8 -> Word8 -lifeRules 0 3 = 1 -lifeRules 1 2 = 1 -lifeRules 1 3 = 1 -lifeRules _ _ = 0 - -lifeStencil :: Stencil Ix2 Word8 Word8 -lifeStencil = makeStencil (Sz (3 :. 3)) (1 :. 1) $ \ get -> - lifeRules <$> get (0 :. 0) <*> - (get (-1 :. -1) + get (-1 :. 0) + get (-1 :. 1) + - get ( 0 :. -1) + get ( 0 :. 1) + - get ( 1 :. -1) + get ( 1 :. 0) + get ( 1 :. 1)) - -life :: Array S Ix2 Word8 -> Array S Ix2 Word8 -life = compute . mapStencil Wrap lifeStencil -``` - - - -The full working example that uses GLUT and OpenGL is located in -[GameOfLife](massiv-examples/GameOfLife/app/GameOfLife.hs) - -# massiv-io - -In order to do anything useful with arrays we need to be able to read some data from a -file. Considering that most common array-like files are images, [massiv-io](massiv-io) provides an -interface to read, write and display images in common formats using Haskell native JuicyPixels and -Netpbm packages. - -There is also a variety of colorspaces (or rather color models) and pixel types -that are currently included in this package, which will likely find a separate -home in the future, but for now we can ignore those colorspaces and -pretend that `Pixel` is some magic wrapper around numeric values that this -package is capable of reading/writing. - -The previous example wasn't particularly interesting, since we couldn't visualize -what is actually going on, so let's expend on it: - -```haskell -import Data.Massiv.Array -import Data.Massiv.Array.IO - -main :: IO () -main = do - let arr = computeAs S $ arrLightIx2 Par (600 :. 800) - toImage :: - (Functor (Array r Ix2), Load r Ix2 (Pixel Y' Word8)) - => Array r Ix2 Double - -> Image S Y' Word8 - toImage = computeAs S . fmap (PixelY' . toWord8) - lightPath = "files/light.png" - lightAvgPath = "files/light_avg.png" - lightSumPath = "files/light_sum.png" - writeImage lightPath $ toImage $ delay arr - putStrLn $ "written: " ++ lightPath - writeImage lightAvgPath $ toImage $ mapStencil Edge average3x3Filter arr - putStrLn $ "written: " ++ lightAvgPath -``` - -`massiv-examples/vision/files/light.png`: - -![Light](massiv-examples/vision/files/light.png) - -`massiv-examples/vision/files/light_avg.png`: - -![Light](massiv-examples/vision/files/light_avg.png) - - -The full example is in the [vision](massiv-examples/vision/app/AvgSum.hs) package and if -you have stack installed you can run it as: - -```bash -$ cd massiv-examples/vision && stack build && stack exec -- avg-sum -``` - -# Other libraries - -A natural question might come to mind: Why even bother with a new array library when we already have -a few really good ones in the Haskell world? The main reasons for me are performance and -usability. I personally felt like there was much room for improvement even before I started work on -this package, and it seems as it turned out to be true. For example, the most common goto library -for dealing with multidimensional arrays and parallel computation is -[Repa](https://hackage.haskell.org/package/repa), which I personally was a big fan of for quite some -time, to the point that I even wrote a [Haskell Image -Processing](https://hackage.haskell.org/package/hip) library based on top of it. - -Here is a quick summary of how `massiv` compares to Repa so far: - -* Better scheduler, that is capable of handling nested parallel computation. -* Also shape polymorphic, but with improved default indexing data types. -* Safe stencils for arbitrary dimensions, not only 2D convolution. Stencils are composable through an - instance of Applicative -* Improved performance on almost all operations. -* Structural parallel folds (i.e. left/right - direction is preserved) -* Super easy slicing. -* Delayed arrays aren't indexable, only Manifest are (saving user from common pitfall in Repa of - trying to read elements of delayed array) - -As far as usability of the library goes, it is very subjective, thus I'll let you be a judge of -that. When talking about performance it is the facts that do matter. Thus, let's not continue this -discussion in pure abstract words, below is a glimpse into benchmarks against Repa library running -with GHC 8.2.2 on Intel® Core™ i7-3740QM CPU @ 2.70GHz × 8 - -Stencil example discussed earlier: - -``` -Benchmark convolve-seq: RUNNING... -benchmarking Stencil/Average/Massiv Parallel -time 6.859 ms (6.694 ms .. 7.142 ms) - 0.994 R² (0.986 R² .. 0.999 R²) -mean 6.640 ms (6.574 ms .. 6.757 ms) -std dev 270.6 μs (168.3 μs .. 473.4 μs) -variance introduced by outliers: 18% (moderately inflated) - -benchmarking Stencil/Average/Repa Parallel -time 39.36 ms (38.33 ms .. 40.58 ms) - 0.997 R² (0.993 R² .. 0.999 R²) -mean 38.15 ms (37.18 ms .. 39.03 ms) -std dev 1.951 ms (1.357 ms .. 2.454 ms) -variance introduced by outliers: 13% (moderately inflated) -``` - - -Sum over an array with a left fold: - -``` -Benchmark fold-seq: RUNNING... -benchmarking Sum (1600x1200)/Sequential/Massiv Ix2 U -time 1.860 ms (1.850 ms .. 1.877 ms) - 1.000 R² (0.999 R² .. 1.000 R²) -mean 1.869 ms (1.861 ms .. 1.886 ms) -std dev 35.77 μs (20.65 μs .. 62.14 μs) - -benchmarking Sum (1600x1200)/Sequential/Vector U -time 1.690 ms (1.686 ms .. 1.694 ms) - 1.000 R² (1.000 R² .. 1.000 R²) -mean 1.686 ms (1.679 ms .. 1.692 ms) -std dev 20.98 μs (16.14 μs .. 27.77 μs) - -benchmarking Sum (1600x1200)/Sequential/Repa DIM2 U -time 40.02 ms (38.05 ms .. 42.81 ms) - 0.993 R² (0.987 R² .. 1.000 R²) -mean 38.40 ms (38.03 ms .. 39.44 ms) -std dev 1.225 ms (303.9 μs .. 2.218 ms) - -benchmarking Sum (1600x1200)/Parallel/Massiv Ix2 U -time 751.3 μs (744.1 μs .. 758.7 μs) - 0.998 R² (0.997 R² .. 0.999 R²) -mean 750.7 μs (741.7 μs .. 762.3 μs) -std dev 32.13 μs (19.02 μs .. 50.21 μs) -variance introduced by outliers: 34% (moderately inflated) - -benchmarking Sum (1600x1200)/Parallel/Repa DIM2 U -time 9.581 ms (9.415 ms .. 9.803 ms) - 0.994 R² (0.988 R² .. 0.998 R²) -mean 9.085 ms (8.871 ms .. 9.281 ms) -std dev 584.2 μs (456.4 μs .. 800.4 μs) -variance introduced by outliers: 34% (moderately inflated) - -Benchmark fold-seq: FINISH -``` - -# Further resources on learning `massiv`: - -* [2019 - Monadic Party - Haskell arrays with Massiv](https://github.com/lehins/talks#2019---monadic-party---haskell-arrays-with-massiv) -* [2018 - Monadic Warsaw #14 - Haskell arrays that are easy and fast](https://github.com/lehins/talks#2018---monadic-warsaw-14---haskell-arrays-that-are-easy-and-fast) diff --git a/README.md b/README.md new file mode 120000 index 00000000..6d42e202 --- /dev/null +++ b/README.md @@ -0,0 +1 @@ +massiv/README.md \ No newline at end of file diff --git a/massiv-bench/bench/Sum.hs b/massiv-bench/bench/Fold.hs similarity index 98% rename from massiv-bench/bench/Sum.hs rename to massiv-bench/bench/Fold.hs index 5afb55a5..58d762ec 100644 --- a/massiv-bench/bench/Sum.hs +++ b/massiv-bench/bench/Fold.hs @@ -11,7 +11,7 @@ import Prelude as P main :: IO () main = do - let !sz = Sz2 1600 12000 + let !sz = Sz2 1600 1200 !arrSeq = arrRLightIx2 P Seq sz !arrPar = arrRLightIx2 P Par sz defaultMain diff --git a/massiv-bench/bench/Sobel.hs b/massiv-bench/bench/Sobel.hs index e9da9ab5..f875aa42 100644 --- a/massiv-bench/bench/Sobel.hs +++ b/massiv-bench/bench/Sobel.hs @@ -12,22 +12,4 @@ import Prelude as P main :: IO () main = do let !sz = Sz2 1600 1200 - defaultMain - [ bgroup - "Sobel" - [ env (return (arrRLightIx2 S Seq sz)) $ \arr -> - bgroup - "Seq" - [ bench "Horizontal - Massiv" $ whnf (computeAs S . A.mapStencil Edge sobelX) arr - , bench "Vertical - Massiv" $ whnf (computeAs S . A.mapStencil Edge sobelY) arr - , bench "Operator - Massiv" $ whnf (computeAs S . A.mapStencil Edge sobelOperator) arr - ] - , env (return (arrRLightIx2 S Par sz)) $ \arr -> - bgroup - "Par" - [ bench "Horizontal - Massiv" $ whnf (computeAs S . A.mapStencil Edge sobelX) arr - , bench "Vertical - Massiv" $ whnf (computeAs S . A.mapStencil Edge sobelY) arr - , bench "Operator - Massiv" $ whnf (computeAs S . A.mapStencil Edge sobelOperator) arr - ] - ] - ] + defaultMain [sobelBenchGroup sz] diff --git a/massiv-bench/massiv-bench.cabal b/massiv-bench/massiv-bench.cabal index 3f2d37fa..0079b1fc 100644 --- a/massiv-bench/massiv-bench.cabal +++ b/massiv-bench/massiv-bench.cabal @@ -42,18 +42,6 @@ benchmark any-all , vector default-language: Haskell2010 -benchmark sum - type: exitcode-stdio-1.0 - hs-source-dirs: bench - main-is: Sum.hs - ghc-options: -Wall -threaded -O2 -rtsopts -with-rtsopts=-N6 - build-depends: base - , criterion - , massiv - -- , massiv-simd - , massiv-bench - default-language: Haskell2010 - benchmark plus type: exitcode-stdio-1.0 hs-source-dirs: bench @@ -169,6 +157,17 @@ benchmark concat , vector default-language: Haskell2010 +benchmark fold + type: exitcode-stdio-1.0 + hs-source-dirs: bench + main-is: Fold.hs + ghc-options: -Wall -threaded -O2 -rtsopts -with-rtsopts=-N + build-depends: base + , criterion + , massiv + , massiv-bench + default-language: Haskell2010 + benchmark filter type: exitcode-stdio-1.0 hs-source-dirs: bench diff --git a/massiv-bench/src/Data/Massiv/Bench.hs b/massiv-bench/src/Data/Massiv/Bench.hs index 1cea959a..951252a8 100644 --- a/massiv-bench/src/Data/Massiv/Bench.hs +++ b/massiv-bench/src/Data/Massiv/Bench.hs @@ -7,36 +7,3 @@ module Data.Massiv.Bench import Data.Massiv.Array import Data.Massiv.Bench.Common - -lightFunc :: Int -> Int -> Double -lightFunc !i !j = - sin (fromIntegral (i ^ (2 :: Int) + j ^ (2 :: Int)) :: Double) -{-# INLINE lightFunc #-} - -heavyFunc :: Int -> Int -> Double -heavyFunc !i !j = - sin (sqrt (sqrt (fromIntegral i ** 2 + fromIntegral j ** 2))) -{-# INLINE heavyFunc #-} - -lightFuncIx2 :: Ix2 -> Double -lightFuncIx2 (i :. j) = lightFunc i j -{-# INLINE lightFuncIx2 #-} - -lightFuncIx2T :: Ix2T -> Double -lightFuncIx2T (i, j) = lightFunc i j -{-# INLINE lightFuncIx2T #-} - -lightFuncIx1 :: Int -- ^ cols - -> Ix1 -- ^ linear index - -> Double -lightFuncIx1 k i = lightFuncIx2T (divMod i k) -{-# INLINE lightFuncIx1 #-} - -arrRLightIx2 :: Load r Ix2 Double => r -> Comp -> Sz2 -> Matrix r Double -arrRLightIx2 _ comp arrSz = makeArray comp arrSz (\ (i :. j) -> lightFunc i j) -{-# INLINE arrRLightIx2 #-} - -arrRHeavyIx2 :: Load r Ix2 Double => r -> Comp -> Sz2 -> Matrix r Double -arrRHeavyIx2 _ comp arrSz = makeArray comp arrSz (\ (i :. j) -> heavyFunc i j) -{-# INLINE arrRHeavyIx2 #-} - diff --git a/massiv-bench/src/Data/Massiv/Bench/Common.hs b/massiv-bench/src/Data/Massiv/Bench/Common.hs index 5321fc87..836cc5a3 100644 --- a/massiv-bench/src/Data/Massiv/Bench/Common.hs +++ b/massiv-bench/src/Data/Massiv/Bench/Common.hs @@ -1,10 +1,16 @@ {-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} module Data.Massiv.Bench.Common ( makeRandomArray , showsType , stdGen + , lightFunc + , heavyFunc + , lightFuncIx2 + , arrRLightIx2 + , arrRHeavyIx2 ) where import Data.Massiv.Array @@ -22,3 +28,26 @@ makeRandomArray :: (Index ix, Manifest r e, Random e) => Sz ix -> IO (Array r ix makeRandomArray sz = do gen <- newStdGen pure $! snd $ randomArrayS gen sz random + +lightFunc :: Int -> Int -> Double +lightFunc !i !j = + sin (fromIntegral (i ^ (2 :: Int) + j ^ (2 :: Int)) :: Double) +{-# INLINE lightFunc #-} + +heavyFunc :: Int -> Int -> Double +heavyFunc !i !j = + sin (sqrt (sqrt (fromIntegral i ** 2 + fromIntegral j ** 2))) +{-# INLINE heavyFunc #-} + +lightFuncIx2 :: Ix2 -> Double +lightFuncIx2 (i :. j) = lightFunc i j +{-# INLINE lightFuncIx2 #-} + +arrRLightIx2 :: Load r Ix2 Double => r -> Comp -> Sz2 -> Matrix r Double +arrRLightIx2 _ comp arrSz = makeArray comp arrSz (\ (i :. j) -> lightFunc i j) +{-# INLINE arrRLightIx2 #-} + +arrRHeavyIx2 :: Load r Ix2 Double => r -> Comp -> Sz2 -> Matrix r Double +arrRHeavyIx2 _ comp arrSz = makeArray comp arrSz (\ (i :. j) -> heavyFunc i j) +{-# INLINE arrRHeavyIx2 #-} + diff --git a/massiv-bench/src/Data/Massiv/Bench/Sobel.hs b/massiv-bench/src/Data/Massiv/Bench/Sobel.hs index 1339f5c4..47730cde 100644 --- a/massiv-bench/src/Data/Massiv/Bench/Sobel.hs +++ b/massiv-bench/src/Data/Massiv/Bench/Sobel.hs @@ -3,10 +3,13 @@ module Data.Massiv.Bench.Sobel ( sobelX , sobelY , sobelOperator + , sobelBenchGroup ) where -import Data.Massiv.Array +import Criterion.Main +import Data.Massiv.Array as A import Data.Massiv.Array.Unsafe +import Data.Massiv.Bench.Common sobelX :: Num e => Stencil Ix2 e e sobelX = @@ -38,3 +41,24 @@ sobelOperator = sqrt (sX + sY) !sX = fmap (^ (2 :: Int)) sobelX !sY = fmap (^ (2 :: Int)) sobelY {-# INLINE sobelOperator #-} + +sobelBenchGroup :: Sz2 -> Benchmark +sobelBenchGroup sz = + bgroup + "Sobel" + [ env (return (arrRLightIx2 S Seq sz)) $ \arr -> + bgroup + "Seq" + [ bench "Horizontal - Massiv" $ whnf (computeAs S . A.mapStencil Edge sobelX) arr + , bench "Vertical - Massiv" $ whnf (computeAs S . A.mapStencil Edge sobelY) arr + , bench "Operator - Massiv" $ whnf (computeAs S . A.mapStencil Edge sobelOperator) arr + ] + , env (return (arrRLightIx2 S Par sz)) $ \arr -> + bgroup + "Par" + [ bench "Horizontal - Massiv" $ whnf (computeAs S . A.mapStencil Edge sobelX) arr + , bench "Vertical - Massiv" $ whnf (computeAs S . A.mapStencil Edge sobelY) arr + , bench "Operator - Massiv" $ whnf (computeAs S . A.mapStencil Edge sobelOperator) arr + ] + ] +{-# INLINEABLE sobelBenchGroup #-} diff --git a/massiv-examples/vision/app/AvgSum.hs b/massiv-examples/vision/app/AvgSum.hs index 619e4fc3..367502b1 100644 --- a/massiv-examples/vision/app/AvgSum.hs +++ b/massiv-examples/vision/app/AvgSum.hs @@ -14,23 +14,6 @@ arrLightIx2 comp arrSz = makeArray comp (Sz arrSz) lightFunc {-# INLINE arrLightIx2 #-} -average3x3Filter :: (Default a, Fractional a) => Stencil Ix2 a a -average3x3Filter = makeStencil (Sz (3 :. 3)) (1 :. 1) $ \ get -> - ( get (-1 :. -1) + get (-1 :. 0) + get (-1 :. 1) + - get ( 0 :. -1) + get ( 0 :. 0) + get ( 0 :. 1) + - get ( 1 :. -1) + get ( 1 :. 0) + get ( 1 :. 1) ) / 9 -{-# INLINE average3x3Filter #-} - - -sum3x3Filter :: Fractional a => Stencil Ix2 a a -sum3x3Filter = makeConvolutionStencil (Sz (3 :. 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 -{-# INLINE sum3x3Filter #-} - - - main :: IO () main = do let arr = computeAs S $ arrLightIx2 Par (600 :. 800) @@ -40,11 +23,16 @@ main = do -> Image S (Y' SRGB) Word8 toImage = computeAs S . fmap (PixelY' . toWord8) lightPath = "files/light.png" + lightImage = toImage $ delay arr lightAvgPath = "files/light_avg.png" + lightAvgImage = toImage $ mapStencil Edge (avgStencil 3) arr lightSumPath = "files/light_sum.png" - writeImage lightPath $ toImage $ delay arr + lightSumImage = toImage $ mapStencil Edge (sumStencil 3) arr + writeImage lightPath lightImage putStrLn $ "written: " ++ lightPath - writeImage lightAvgPath $ toImage $ mapStencil Edge average3x3Filter arr + writeImage lightAvgPath lightAvgImage putStrLn $ "written: " ++ lightAvgPath - writeImage lightSumPath $ toImage $ mapStencil Edge sum3x3Filter arr + writeImage lightSumPath lightSumImage putStrLn $ "written: " ++ lightSumPath + displayImageUsing defaultViewer True . computeAs S + =<< concatM 1 [lightAvgImage, lightImage, lightSumImage] diff --git a/massiv-examples/vision/stack.yaml b/massiv-examples/vision/stack.yaml deleted file mode 100644 index 32edaa9f..00000000 --- a/massiv-examples/vision/stack.yaml +++ /dev/null @@ -1,13 +0,0 @@ -resolver: lts-18.3 -packages: -- . -- ../../massiv -extra-deps: -- github: lehins/massiv-io - commit: 45ab3265b50f792daafefa8d9b686483fb058538 - subdirs: - - massiv-io -- github: lehins/haskell-scheduler - commit: c5506d20d96fc3fb00c213791243b7246d39e822 - subdirs: - - scheduler diff --git a/massiv/README.md b/massiv/README.md index fd515e4f..9f1c3e06 100644 --- a/massiv/README.md +++ b/massiv/README.md @@ -1,10 +1,670 @@ # massiv -Efficient Haskell Arrays featuring Parallel computation +`massiv` is a Haskell library for array manipulation. Performance is one of its main goals, thus it +is capable of seamless parallelization of most of the operations provided by the library -There is a decent introduction to the library with some examples in the main -[README](https://github.com/lehins/massiv/blob/master/README.md) on github. +The name for this library comes from the Russian word Massiv (Масси́в), which means an Array. -See [massiv-io](https://hackage.haskell.org/package/massiv-io) for ability to read/write images. +## Status +| Language | Github Actions | Coveralls |Gitter.im | +|:--------:|:--------------:|:---------:|:--------:| +| ![GitHub top language](https://img.shields.io/github/languages/top/lehins/massiv.svg) | [![Build Status](https://github.com/lehins/massiv/workflows/massiv-CI/badge.svg)](https://github.com/lehins/massiv/actions) | [![Coverage Status](https://coveralls.io/repos/github/lehins/massiv/badge.svg?branch=master)](https://coveralls.io/github/lehins/massiv?branch=master) | [![Join the chat at https://gitter.im/haskell-massiv/Lobby](https://badges.gitter.im/haskell-massiv/Lobby.svg)](https://gitter.im/haskell-massiv/Lobby?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) +| Package | Hackage | Nightly | LTS | +|:-------------------|:-------:|:-------:|:---:| +| [`massiv`](https://github.com/lehins/massiv/tree/master/massiv)| [![Hackage](https://img.shields.io/hackage/v/massiv.svg)](https://hackage.haskell.org/package/massiv)| [![Nightly](https://www.stackage.org/package/massiv/badge/nightly)](https://www.stackage.org/nightly/package/massiv)| [![Nightly](https://www.stackage.org/package/massiv/badge/lts)](https://www.stackage.org/lts/package/massiv)| +| [`massiv-io`](https://github.com/lehins/massiv-io)| [![Hackage](https://img.shields.io/hackage/v/massiv-io.svg)](https://hackage.haskell.org/package/massiv-io)| [![Nightly](https://www.stackage.org/package/massiv-io/badge/nightly)](https://www.stackage.org/nightly/package/massiv-io)| [![Nightly](https://www.stackage.org/package/massiv-io/badge/lts)](https://www.stackage.org/lts/package/massiv-io)| +| [`massiv-test`](https://github.com/lehins/massiv/tree/master/massiv-test)| [![Hackage](https://img.shields.io/hackage/v/massiv-test.svg)](https://hackage.haskell.org/package/massiv-test)| [![Nightly](https://www.stackage.org/package/massiv-test/badge/nightly)](https://www.stackage.org/nightly/package/massiv-test)| [![Nightly](https://www.stackage.org/package/massiv-test/badge/lts)](https://www.stackage.org/lts/package/massiv-test)| +| [`haskell-scheduler`](https://github.com/lehins/haskell-scheduler)| [![Hackage](https://img.shields.io/hackage/v/scheduler.svg)](https://hackage.haskell.org/package/scheduler)| [![Nightly](https://www.stackage.org/package/scheduler/badge/nightly)](https://www.stackage.org/nightly/package/scheduler)| [![Nightly](https://www.stackage.org/package/scheduler/badge/lts)](https://www.stackage.org/lts/package/scheduler)| + +## Introduction + +Everything in the library revolves around an `Array r ix e` - a data family for anything that can be +thought of as an array. The type variables, from the end, are: + +* `e` - element of an array. +* `ix` - an index that will map to an actual element. The index must be an instance of the `Index` + class with the default one being an `Ix n` type family and an optional being tuples of `Int`s. +* `r` - underlying representation. There are two main categories of representations described below. + +### Manifest + +These are your classical arrays that are located in memory and allow constant time lookup of +elements. Another main property they share is that they have a mutable interface. An `Array` with +manifest representation can be thawed into a mutable `MArray` and then frozen back into its +immutable counterpart after some destructive operation is applied to the mutable copy. The +differences among representations below is in the way that elements are being accessed in memory: + + * `P` - Array with elements that are an instance of `Prim` type class, i.e. common Haskell + primitive types: `Int`, `Word`, `Char`, etc. It is backed by unpinned memory and based on + [`ByteArray`](https://hackage.haskell.org/package/primitive/docs/Data-Primitive-ByteArray.html#t:ByteArray). + * `U` - Unboxed arrays. The elements are instances of the + [`Unbox`](https://hackage.haskell.org/package/vector/docs/Data-Vector-Unboxed.html#t:Vector) + type class. Usually just as fast as `P`, but has a slightly wider range of data types that it + can work with. Notable data types that can be stored as elements are `Bool`, tuples and `Ix n`. + * `S` - Storable arrays. Backed by pinned memory and based on `ForeignPtr`, while elements are + instances of the `Storable` type class. + * `B` - Boxed arrays that don't have restrictions on their elements, since they are represented + as pointers to elements, thus making them the slowest type of array, but also the most + general. Arrays of this representation are element strict, in other words its elements are + kept in Weak-Head Normal Form (WHNF). + * `BN` - Also boxed arrays, but unlike the other representation `B`, its elements are in Normal + Form, i.e. in a fully evaluated state and no thunks or memory leaks are possible. It does + require an `NFData` instance for the elements though. + * `BL` - Boxed lazy array. Just like `B` and `BN`, except values are evaluated on demand. + +### Delayed + +Main trait of delayed arrays is that they do not exist in memory and instead describe the contents +of an array as a function or a composition of functions. In fact all of the fusion capabilities in +`massiv` can be attributed to delayed arrays. + + * `D` - Delayed "pull" array is just a function from an index to an element: `(ix -> + e)`. Therefore indexing into this type of array is not possible, instead elements are evaluated + with the `evaluateM` function each time when applied to an index. It gives us a nice ability to + compose functions together when applied to an array and possibly even fold over without ever + allocating intermediate manifest arrays. + * `DW` - Delayed windowed array is very similar to the version above, except it has two functions + that describe it, one for the near border elements and one for the interior, aka. the + window. This is used for [`Stencil`](stencil) computation and things that derive from it, such as + convolution, for instance. + * `DL` - Delayed "push" array contains a monadic action that describes how an array can be loaded + into memory. This is most useful for composing arrays together. + * `DS` - Delayed stream array is a sequence of elements, possibly even an infinite one. This is + most useful for situations when we don't know the size of our resulting array ahead of time, + which is common in operations such as `filter`, `mapMaybe`, `unfold` etc. Naturally, in the end + we can only load such an array into a flat vector. + * `DI` - Is just like `D`, except loading is interleaved and is useful for parallel loading + arrays with unbalanced computation, such as Mandelbrot set or ray tracing, for example. + +## Construct + +Creating a delayed type of array allows us to fuse any future operations we decide to perform on +it. Let's look at this example: + +```haskell +λ> import Data.Massiv.Array as A +λ> makeVectorR D Seq 10 id +Array D Seq (Sz1 10) + [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9 ] +``` + +Here we created a delayed vector of size 10, which is in reality just an `id` function from its +index to an element (see the [Computation](#computation) section for the meaning of `Seq`). So let's +go ahead and square its elements + +```haskell +λ> makeVectorR D Seq 10 id +λ> evaluateM vec 4 +4 +λ> vec2 = A.map (^ (2 :: Int)) vec +λ> evaluateM vec2 4 +16 +``` + +It's not that exciting, since every time we call `evaluateM` it will recompute the element, __every +time__, therefore this function should be avoided at all costs! Instead we can use all of the +functions that take `Source` like arrays and then fuse that computation together by calling +`compute`, or a handy `computeAs` function and only afterwards apply an `indexM` function or its +partial synonym: `(!)`. Any delayed array can also be reduced using one of the folding functions, +thus completely avoiding any memory allocation, or converted to a list, if that's what you need: + +```haskell +λ> vec2U = computeAs U vec2 +λ> vec2U +Array U Seq (Sz1 10) + [ 0, 1, 4, 9, 16, 25, 36, 49, 64, 81 ] +λ> vec2U ! 4 +16 +λ> toList vec2U +[0,1,4,9,16,25,36,49,64,81] +λ> A.sum vec2U +285 +``` + +There is a whole multitude of ways to construct arrays: + * by using one of many helper functions: `makeArray`, `range`, `rangeStepFrom`, `enumFromN`, etc. + * through conversion: from lists, from `Vector`s in `vector` library, from `ByteString`s in + `bytestring`; + * with a mutable interface in `PrimMonad` (`IO`, `ST`, etc.), eg: `makeMArray`, + `generateArray`, `unfoldrPrim`, etc. + +It's worth noting that, in the next example, nested lists will be loaded into an unboxed manifest +array and the sum of its elements will be computed in parallel on all available cores. + +```haskell +λ> A.sum (fromLists' Par [[0,0,0,0,0],[0,1,2,3,4],[0,2,4,6,8]] :: Array U Ix2 Double) +30.0 +``` + +The above wouldn't run in parallel in ghci of course, as the program would have to be compiled with +`ghc` using `-threaded -with-rtsopts=-N` flags in order to use all available cores. Alternatively we +could compile with the `-threaded` flag and then pass the number of capabilities directly to the +runtime with `+RTS -N`, where `` is the number of cores you'd like to utilize. + +## Index + +The main `Ix n` closed type family can be somewhat confusing, but there is no need to fully +understand how it works in order to start using it. GHC might ask you for the `DataKinds` language +extension if `IxN n` is used in a type signature, but there are type and pattern synonyms for the +first five dimensions: `Ix1`, `Ix2`, `Ix3`, `Ix4` and `Ix5`. + +There are three distinguishable constructors for the index: + +* The first one is simply an int: `Ix1 = Ix 1 = Int`, therefore vectors can be indexed in a usual way + without some extra wrapping data type, just as it was demonstrated in a previous section. +* The second one is `Ix2` for operating on 2-dimensional arrays and has a constructor `:.` + +```haskell +λ> makeArrayR D Seq (Sz (3 :. 5)) (\ (i :. j) -> i * j) +Array D Seq (Sz (3 :. 5)) + [ [ 0, 0, 0, 0, 0 ] + , [ 0, 1, 2, 3, 4 ] + , [ 0, 2, 4, 6, 8 ] + ] +``` + +* The third one is `IxN n` and is designed for working with N-dimensional arrays, and has a similar + looking constructor `:>`, except that it can be chained indefinitely on top of `:.` + +```haskell +λ> arr3 = makeArrayR P Seq (Sz (3 :> 2 :. 5)) (\ (i :> j :. k) -> i * j + k) +λ> :t arr3 +arr3 :: Array P (IxN 3) Int +λ> arr3 +Array P Seq (Sz (3 :> 2 :. 5)) + [ [ [ 0, 1, 2, 3, 4 ] + , [ 0, 1, 2, 3, 4 ] + ] + , [ [ 0, 1, 2, 3, 4 ] + , [ 1, 2, 3, 4, 5 ] + ] + , [ [ 0, 1, 2, 3, 4 ] + , [ 2, 3, 4, 5, 6 ] + ] + ] +λ> arr3 ! (2 :> 1 :. 4) +6 +λ> ix10 = 10 :> 9 :> 8 :> 7 :> 6 :> 5 :> 4 :> 3 :> 2 :. 1 +λ> :t ix10 +ix10 :: IxN 10 +λ> ix10 -- 10-dimensional index +10 :> 9 :> 8 :> 7 :> 6 :> 5 :> 4 :> 3 :> 2 :. 1 +``` + +Here is how we can construct a 4-dimensional array and sum its elements in constant memory: + +```haskell +λ> arr = makeArrayR D Seq (Sz (10 :> 20 :> 30 :. 40)) $ \ (i :> j :> k :. l) -> (i * j + k) * k + l +λ> :t arr -- a 4-dimensional array +arr :: Array D (IxN 4) Int +λ> A.sum arr +221890000 +``` + +There are quite a few helper functions that can operate on indices, but these are only needed when +writing functions that work for arrays of arbitrary dimension, as such they are scarcely used: + +```haskell +λ> pullOutDim' ix10 5 +(5,10 :> 9 :> 8 :> 7 :> 6 :> 4 :> 3 :> 2 :. 1) +λ> unconsDim ix10 +(10,9 :> 8 :> 7 :> 6 :> 5 :> 4 :> 3 :> 2 :. 1) +λ> unsnocDim ix10 +(10 :> 9 :> 8 :> 7 :> 6 :> 5 :> 4 :> 3 :. 2,1) +``` + +All of the `Ix n` indices are instances of `Num` so basic numeric operations are made easier: + +```haskell +λ> (1 :> 2 :. 3) + (4 :> 5 :. 6) +5 :> 7 :. 9 +λ> 5 :: Ix4 +5 :> 5 :> 5 :. 5 +``` + +It is important to note that the size type is distinct from the index by the newtype wrapper `Sz +ix`. There is a constructor `Sz`, which will make sure that none of the dimensions are negative: + +```haskell +λ> Sz (2 :> 3 :. 4) +Sz (2 :> 3 :. 4) +λ> Sz (10 :> 2 :> -30 :. 4) +Sz (10 :> 2 :> 0 :. 4) +``` + +Same as with indices, there are helper pattern synonyms: `Sz1`, `Sz2`, `Sz3`, `Sz4` and `Sz5`. + +```haskell +λ> Sz3 2 3 4 +Sz (2 :> 3 :. 4) +λ> Sz4 10 2 (-30) 4 +Sz (10 :> 2 :> 0 :. 4) +``` + +As well as the `Num` instance: + +```haskell +λ> 4 :: Sz5 +Sz (4 :> 4 :> 4 :> 4 :. 4) +λ> (Sz2 1 2) + 3 +Sz (4 :. 5) +λ> (Sz2 1 2) - 3 +Sz (0 :. 0) +``` + +Alternatively tuples of `Int`s can be used for working with arrays, up to and including 5-tuples +(type synonyms: `Ix2T` .. `Ix5T`), but since tuples are polymorphic it is necessary to restrict the +resulting array type. Not all operations in the library support tuples, so it is advised to avoid +them for indexing. + +```haskell +λ> makeArray Seq (4, 20) (uncurry (*)) :: Array P Ix2T Int +(Array P Seq ((4,20)) + [ [ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 ] + , [ 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19 ] + , [ 0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38 ] + , [ 0,3,6,9,12,15,18,21,24,27,30,33,36,39,42,45,48,51,54,57 ] + ]) +λ> :i Ix2T +type Ix2T = (Int, Int) +``` + +There are helper functions that can go back and forth between tuples and `Ix n` indices. + +```haskell +λ> fromIx4 (3 :> 4 :> 5 :. 6) +(3,4,5,6) +λ> toIx5 (3, 4, 5, 6, 7) +3 :> 4 :> 5 :> 6 :. 7 +``` + +## Slicing + +In order to get a subsection of an array there is no need to recompute it, unless we want to free up +the no longer memory, of course. So, there are a few slicing, resizing and extraction operators that +can do it all in constant time, modulo the index manipulation: + +```haskell +λ> arr = makeArrayR U Seq (Sz (4 :> 2 :. 6)) fromIx3 +λ> arr !> 3 !> 1 +Array M Seq (Sz1 6) + [ (3,1,0), (3,1,1), (3,1,2), (3,1,3), (3,1,4), (3,1,5) ] +``` + +As you might suspect all of the slicing, indexing, extracting, resizing operations are partial, and +those are frowned upon in Haskell. So there are matching functions that can do the same operations +safely by using `MonadThrow` and thus returning `Nothing`, `Left SomeException` or throwing an +exception in case of `IO` on failure, for example: + +```haskell +λ> arr !?> 3 ??> 1 +Array M Seq (Sz1 6) + [ (3,1,0), (3,1,1), (3,1,2), (3,1,3), (3,1,4), (3,1,5) ] +λ> arr !?> 3 ??> 1 ?? 0 :: Maybe (Int, Int, Int) +Just (3,1,0) +``` + +In above examples we first take a slice at the 4th page (index 3, since we start at 0), then another +one at the 2nd row (index 1). While in the last example we also take 1st element at +position 0. Pretty neat, huh? Naturally, by doing a slice we always reduce dimension by one. We can +do slicing from the outside as well as from the inside: + +```haskell +λ> Ix1 1 ... 9 +Array D Seq (Sz1 10) + [ 1, 2, 3, 4, 5, 6, 7, 8, 9 ] +λ> a <- resizeM (Sz (3 :> 2 :. 4)) $ Ix1 11 ... 34 +λ> a +Array D Seq (Sz (3 :> 2 :. 4)) + [ [ [ 11, 12, 13, 14 ] + , [ 15, 16, 17, 18 ] + ] + , [ [ 19, 20, 21, 22 ] + , [ 23, 24, 25, 26 ] + ] + , [ [ 27, 28, 29, 30 ] + , [ 31, 32, 33, 34 ] + ] + ] +λ> a !> 0 +Array D Seq (Sz (2 :. 4)) + [ [ 11, 12, 13, 14 ] + , [ 15, 16, 17, 18 ] + ] +λ> a a (Dim 2, 0) +Array D Seq (Sz (3 :. 4)) + [ [ 11, 12, 13, 14 ] + , [ 19, 20, 21, 22 ] + , [ 27, 28, 29, 30 ] + ] +``` + +In order to extract sub-array while preserving dimensionality we can use `extractM` or `extractFromToM`. + +```haskell +λ> extractM (0 :> 1 :. 1) (Sz (3 :> 1 :. 2)) a +Array D Seq (Sz (3 :> 1 :. 2)) + [ [ [ 16, 17 ] + ] + , [ [ 24, 25 ] + ] + , [ [ 32, 33 ] + ] + ] +λ> extractFromToM (1 :> 0 :. 1) (3 :> 2 :. 4) a +Array D Seq (Sz (2 :> 2 :. 3)) + [ [ [ 20, 21, 22 ] + , [ 24, 25, 26 ] + ] + , [ [ 28, 29, 30 ] + , [ 32, 33, 34 ] + ] + ] +``` + +## Computation and parallelism + +There is a data type `Comp` that controls how elements will be computed when calling the `compute` +function. It has a few constructors, although most of the time either `Seq` or `Par` will be +sufficient: + +* `Seq` - computation will be done sequentially on one core (capability in ghc). +* `ParOn [Int]` - perform computation in parallel while pinning the workers to particular + cores. Providing an empty list will result in the computation being distributed over all + available cores, or better known in Haskell as capabilities. +* `ParN Word16` - similar to `ParOn`, except it simply specifies the number of cores to + use, with `0` meaning all cores. +* `Par` - isn't really a constructor but a `pattern` for constructing `ParOn []`, which + will result in Scheduler using all cores, thus should be used instead of `ParOn`. +* `Par'` - similar to `Par`, except it uses `ParN 0` underneath. + +Just to make sure a simple novice mistake is prevented, which I have seen in the past, make sure +your source code is compiled with `ghc -O2 -threaded -with-rtsopts=-N`, otherwise no parallelization +and poor performance are waiting for you. Also a bit later you might notice the `{-# INLINE funcName +#-}` pragma being used, oftentimes it is a good idea to do that, but not always required. It is +worthwhile to benchmark and experiment. + +## Stencil + +Instead of manually iterating over a multi-dimensional array and applying a function to each element, +while reading its neighboring elements (as you would do in an imperative language) in a functional +language it is much more efficient to apply a stencil function and let the library take care of all +of bounds checking and iterating in a cache friendly manner. + +What's a [stencil](https://en.wikipedia.org/wiki/Stencil_code)? It is a declarative way of +specifying a pattern for how elements of an array in a neighborhood will be used in order to update +each element of the newly created array. In massiv a `Stencil` is a function that can read the +neighboring elements of the stencil's _center_ (the zero index), and only those, and then outputs a +new value for the center element. + +![stencil](massiv-examples/files/stencil.png) + +Let's create a simple, but somewhat meaningful array and create an averaging stencil. There is +nothing special about the array itself, but the averaging filter is a stencil that sums the elements +in a [Moore neighborhood](https://en.wikipedia.org/wiki/Moore_neighborhood) and divides the result +by 9, i.e. finds the average of a 3 by 3 square. + +```haskell +arrLightIx2 :: Comp -> Sz Ix2 -> Array D Ix2 Double +arrLightIx2 comp arrSz = makeArray comp arrSz $ \ (i :. j) -> sin (fromIntegral (i * i + j * j)) +{-# INLINE arrLightIx2 #-} + +average3x3Filter :: Fractional a => Stencil Ix2 a a +average3x3Filter = makeStencil (Sz (3 :. 3)) (1 :. 1) $ \ get -> + ( get (-1 :. -1) + get (-1 :. 0) + get (-1 :. 1) + + get ( 0 :. -1) + get ( 0 :. 0) + get ( 0 :. 1) + + get ( 1 :. -1) + get ( 1 :. 0) + get ( 1 :. 1) ) / 9 +{-# INLINE average3x3Filter #-} +``` + +Here is what it would look like in GHCi. We create a delayed array with some funky periodic +function, and make sure it is computed prior to mapping an average stencil over it: + +```haskell +λ> arr = computeAs U $ arrLightIx2 Par (Sz (600 :. 800)) +λ> :t arr +arr :: Array U Ix2 Double +λ> :t mapStencil Edge average3x3Filter arr +mapStencil Edge average3x3Filter arr :: Array DW Ix2 Double +``` + +As you can see, that operation produced an array of the earlier mentioned representation Delayed +Windowed `DW`. In its essence `DW` is an array type that does no bounds checking in order to gain +performance, except when it's near the border, where it uses a border resolution technique supplied +by the user (`Edge` in the example above). Currently it is used only in stencils and not much else +can be done to an array of this type besides further computing it into a manifest representation. + +This example will be continued in the next section, but before that I would like to mention that +some might notice that it looks very much like convolution, and in fact convolution can be +implemented with a stencil. There is a helper function `makeConvolutionStencil` that lets +you do just that. For the sake of example we'll do a sum of all neighbors by hand instead: + +```haskell +sum3x3Filter :: Fractional a => Stencil Ix2 a a +sum3x3Filter = makeConvolutionStencil (Sz (3 :. 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 +{-# INLINE sum3x3Filter #-} +``` + +There is not a single plus or multiplication sign, that is because convolutions is actually +summation of elements multiplied by a kernel element, so instead we have composition of functions +applied to an offset index and a multiplier. After we map that stencil, we can further divide each +element of the array by 9 in order to get the average. Yeah, I lied a bit, `Array DW ix` is an +instance of `Functor` class, so we can map functions over it, which will be fused as with a regular +`D`elayed array: + +```haskell +computeAs U $ fmap (/9) $ mapStencil Edge sum3x3Filter arr +``` + +If you are still confused of what a stencil is, but you are familiar with [Conway's Game of +Life](https://en.wikipedia.org/wiki/Conway%27s_Game_of_Life) this should hopefully clarify it a +bit more. The function `life` below is a single iteration of Game of Life: + +```haskell +lifeRules :: Word8 -> Word8 -> Word8 +lifeRules 0 3 = 1 +lifeRules 1 2 = 1 +lifeRules 1 3 = 1 +lifeRules _ _ = 0 + +lifeStencil :: Stencil Ix2 Word8 Word8 +lifeStencil = makeStencil (Sz (3 :. 3)) (1 :. 1) $ \ get -> + lifeRules (get (0 :. 0)) $ get (-1 :. -1) + get (-1 :. 0) + get (-1 :. 1) + + get ( 0 :. -1) + get ( 0 :. 1) + + get ( 1 :. -1) + get ( 1 :. 0) + get ( 1 :. 1) + +life :: Array S Ix2 Word8 -> Array S Ix2 Word8 +life = compute . mapStencil Wrap lifeStencil +``` + + + +The full working example that uses GLUT and OpenGL is located in +[GameOfLife](massiv-examples/GameOfLife/app/GameOfLife.hs). You can run it if you have the GLUT +dependencies installed: + +```bash +$ cd massiv-examples && stack run GameOfLife +``` + +# massiv-io + +In order to do anything useful with arrays we often need to be able to read some data from a +file. Considering that most common array-like files are images, +[massiv-io](https://github.com/lehins/massiv-io) provides an interface to read, write and display +images in common formats using Haskell native JuicyPixels and Netpbm packages. + +[Color](https://github.com/lehins/Color) package provides a variety of color spaces and conversions +between them, which are used by `massiv-io` package as pixels during reading and writing images. + +An earlier example wasn't particularly interesting, since we couldn't visualize what is actually +going on, so let's expand on it: + +```haskell +import Data.Massiv.Array +import Data.Massiv.Array.IO + +main :: IO () +main = do + let arr = computeAs S $ arrLightIx2 Par (600 :. 800) + toImage :: + (Functor (Array r Ix2), Load r Ix2 (Pixel (Y' SRGB) Word8)) + => Array r Ix2 Double + -> Image S (Y' SRGB) Word8 + toImage = computeAs S . fmap (PixelY' . toWord8) + lightPath = "files/light.png" + lightImage = toImage $ delay arr + lightAvgPath = "files/light_avg.png" + lightAvgImage = toImage $ mapStencil Edge (avgStencil 3) arr + lightSumPath = "files/light_sum.png" + lightSumImage = toImage $ mapStencil Edge (sumStencil 3) arr + writeImage lightPath lightImage + putStrLn $ "written: " ++ lightPath + writeImage lightAvgPath lightAvgImage + putStrLn $ "written: " ++ lightAvgPath + writeImage lightSumPath lightSumImage + putStrLn $ "written: " ++ lightSumPath + displayImageUsing defaultViewer True . computeAs S + =<< concatM 1 [lightAvgImage, lightImage, lightSumImage] +``` + +`massiv-examples/vision/files/light.png`: + +![Light](massiv-examples/vision/files/light.png) + +`massiv-examples/vision/files/light_avg.png`: + +![Light Average](massiv-examples/vision/files/light_avg.png) + + +The full example is in the example [vision](massiv-examples/vision/app/AvgSum.hs) package and if you +have `stack` installed you can run it as: + +```bash +$ cd massiv-examples && stack run avg-sum +``` + +# Other libraries + +A natural question might come to mind: Why even bother with a new array library when we already have +a few really good ones in the Haskell world? The main reasons for me are performance and +usability. I personally felt like there was much room for improvement before I even started working on +this package, and it seems like it turned out to be true. For example, the most common goto library +for dealing with multidimensional arrays and parallel computation used to be +[Repa](https://hackage.haskell.org/package/repa), which I personally was a big fan of for quite some +time, to the point that I even wrote a [Haskell Image +Processing](https://hackage.haskell.org/package/hip) library based on top of it. + +Here is a quick summary of how `massiv` is better than `Repa`: + +* It is actively maintained. +* Much more sophisticated scheduler. It is resumable and is capable of handling nested parallel + computation. +* Improved indexing data types. +* Safe stencils for arbitrary dimensions, not only 2D convolution. Stencils are composable +* Improved performance on almost all operations. +* Structural parallel folds (i.e. left/right - direction is preserved) +* Super easy slicing. +* Extensive mutable interface +* More fusion capabilities with delayed stream and push array representations. +* Delayed arrays aren't indexable, only Manifest are (saving user from common pitfall in Repa of + trying to read elements of delayed array) + +As far as usability of the library goes, it is very subjective, thus I'll let you be a judge of +that. When talking about performance it is the facts that do matter. Thus, let's not continue this +discussion in pure abstract words, below is a glimpse into benchmarks against Repa library running +with GHC 8.8.4 on Intel® Core™ i7-3740QM CPU @ 2.70GHz × 8 + +[Matrix multiplication](https://en.wikipedia.org/wiki/Matrix_multiplication_algorithm): + +``` +benchmarking Repa/MxM U Double - (500x800 X 800x500)/Par +time 120.5 ms (115.0 ms .. 127.2 ms) + 0.998 R² (0.996 R² .. 1.000 R²) +mean 124.1 ms (121.2 ms .. 127.3 ms) +std dev 5.212 ms (2.422 ms .. 6.620 ms) +variance introduced by outliers: 11% (moderately inflated) + +benchmarking Massiv/MxM U Double - (500x800 X 800x500)/Par +time 41.46 ms (40.67 ms .. 42.45 ms) + 0.998 R² (0.994 R² .. 0.999 R²) +mean 38.45 ms (37.22 ms .. 39.68 ms) +std dev 2.342 ms (1.769 ms .. 3.010 ms) +variance introduced by outliers: 19% (moderately inflated) +``` + +[Sobel operator](https://en.wikipedia.org/wiki/Sobel_operator): +``` +benchmarking Sobel/Par/Operator - Repa +time 17.82 ms (17.30 ms .. 18.32 ms) + 0.997 R² (0.994 R² .. 0.998 R²) +mean 17.42 ms (17.21 ms .. 17.69 ms) +std dev 593.0 μs (478.1 μs .. 767.5 μs) +variance introduced by outliers: 12% (moderately inflated) + +benchmarking Sobel/Par/Operator - Massiv +time 7.421 ms (7.230 ms .. 7.619 ms) + 0.994 R² (0.991 R² .. 0.997 R²) +mean 7.537 ms (7.422 ms .. 7.635 ms) +std dev 334.3 μs (281.3 μs .. 389.9 μs) +variance introduced by outliers: 20% (moderately inflated) +``` + +Sum all elements of a 2D array: + +``` +benchmarking Sum/Seq/Repa +time 539.7 ms (523.2 ms .. 547.9 ms) + 1.000 R² (1.000 R² .. 1.000 R²) +mean 540.1 ms (535.7 ms .. 543.2 ms) +std dev 4.727 ms (2.208 ms .. 6.609 ms) +variance introduced by outliers: 19% (moderately inflated) + +benchmarking Sum/Seq/Vector +time 16.95 ms (16.78 ms .. 17.07 ms) + 0.999 R² (0.998 R² .. 1.000 R²) +mean 17.23 ms (17.13 ms .. 17.43 ms) +std dev 331.4 μs (174.1 μs .. 490.0 μs) + +benchmarking Sum/Seq/Massiv +time 16.78 ms (16.71 ms .. 16.85 ms) + 1.000 R² (1.000 R² .. 1.000 R²) +mean 16.80 ms (16.76 ms .. 16.88 ms) +std dev 127.8 μs (89.95 μs .. 186.2 μs) + +benchmarking Sum/Par/Repa +time 81.76 ms (78.52 ms .. 84.37 ms) + 0.997 R² (0.990 R² .. 1.000 R²) +mean 79.20 ms (78.03 ms .. 80.91 ms) +std dev 2.613 ms (1.565 ms .. 3.736 ms) + +benchmarking Sum/Par/Massiv +time 8.102 ms (7.971 ms .. 8.216 ms) + 0.999 R² (0.998 R² .. 1.000 R²) +mean 7.967 ms (7.852 ms .. 8.028 ms) +std dev 236.4 μs (168.4 μs .. 343.2 μs) +variance introduced by outliers: 11% (moderately inflated) +``` + +Here is also a blog post that compares [Performance of Haskell Array libraries through Canny edge detection](https://alexey.kuleshevi.ch/blog/2020/07/10/canny-benchmarks/) + +# Further resources on learning `massiv`: + +* [2019 - Monadic Party - Haskell arrays with Massiv](https://github.com/lehins/talks#2019---monadic-party---haskell-arrays-with-massiv) +* [2018 - Monadic Warsaw #14 - Haskell arrays that are easy and fast](https://github.com/lehins/talks#2018---monadic-warsaw-14---haskell-arrays-that-are-easy-and-fast) diff --git a/massiv/massiv.cabal b/massiv/massiv.cabal index 31bbd4bc..974ccd7a 100644 --- a/massiv/massiv.cabal +++ b/massiv/massiv.cabal @@ -20,6 +20,7 @@ tested-with: GHC == 8.4.3 , GHC == 8.6.5 , GHC == 8.8.4 , GHC == 8.10.2 + , GHC == 9.0.1 flag unsafe-checks description: Enable all the bounds checks for unsafe functions at the cost of diff --git a/massiv/src/Data/Massiv/Array/Delayed/Interleaved.hs b/massiv/src/Data/Massiv/Array/Delayed/Interleaved.hs index c40bd4c7..9e9cbc75 100644 --- a/massiv/src/Data/Massiv/Array/Delayed/Interleaved.hs +++ b/massiv/src/Data/Massiv/Array/Delayed/Interleaved.hs @@ -15,6 +15,7 @@ -- module Data.Massiv.Array.Delayed.Interleaved ( DI(..) + , Array(..) , toInterleaved , fromInterleaved ) where diff --git a/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs b/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs index f53153b8..a5ec778d 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Boxed.hs @@ -24,6 +24,7 @@ module Data.Massiv.Array.Manifest.Boxed , N , pattern N , Array(..) + , MArray(..) , wrapLazyArray , unwrapLazyArray , unwrapNormalForm diff --git a/massiv/src/Data/Massiv/Array/Manifest/List.hs b/massiv/src/Data/Massiv/Array/Manifest/List.hs index bacc6c63..54d75643 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/List.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/List.hs @@ -173,7 +173,7 @@ toList !arr = GHC.build (\ c n -> foldrFB c n arr) -- -- @since 0.1.0 toLists :: - (Ragged L ix e, Load r ix e, Source r e) + (Ragged L ix e, Shape r ix, Source r e) => Array r ix e -- ^ Array to be converted to nested lists -> [ListItem ix e] toLists = GHC.toList . toListArray @@ -193,7 +193,7 @@ toLists = GHC.toList . toListArray -- [[(0,0,0),(0,0,1),(0,0,2)],[(1,0,0),(1,0,1),(1,0,2)]] -- -- @since 0.1.0 -toLists2 :: (Index ix, Source r e, Index (Lower ix)) => Array r ix e -> [[e]] +toLists2 :: (Source r e, Index ix, Index (Lower ix)) => Array r ix e -> [[e]] toLists2 = toList . foldrInner (:) [] {-# INLINE toLists2 #-} @@ -203,7 +203,7 @@ toLists2 = toList . foldrInner (:) [] -- -- @since 0.1.0 toLists3 :: - (Index (Lower (Lower ix)), Index (Lower ix), Index ix, Source r e) => Array r ix e -> [[[e]]] + (Source r e, Index ix, Index (Lower ix), Index (Lower (Lower ix))) => Array r ix e -> [[[e]]] toLists3 = toList . foldrInner (:) [] . foldrInner (:) [] {-# INLINE toLists3 #-} @@ -212,11 +212,11 @@ toLists3 = toList . foldrInner (:) [] . foldrInner (:) [] -- -- @since 0.1.0 toLists4 :: - ( Index (Lower (Lower (Lower ix))) - , Index (Lower (Lower ix)) - , Index (Lower ix) + ( Source r e , Index ix - , Source r e + , Index (Lower ix) + , Index (Lower (Lower ix)) + , Index (Lower (Lower (Lower ix))) ) => Array r ix e -> [[[[e]]]] diff --git a/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs b/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs index a5f0927a..b5c8367c 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Primitive.hs @@ -20,6 +20,7 @@ module Data.Massiv.Array.Manifest.Primitive ( P(..) , Array(..) + , MArray(..) , Prim , toPrimitiveVector , toPrimitiveMVector diff --git a/massiv/src/Data/Massiv/Array/Manifest/Storable.hs b/massiv/src/Data/Massiv/Array/Manifest/Storable.hs index 00256186..de4ae7ee 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Storable.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Storable.hs @@ -18,6 +18,7 @@ module Data.Massiv.Array.Manifest.Storable ( S (..) , Array(..) + , MArray(..) , Storable , toStorableVector , toStorableMVector diff --git a/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs b/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs index 9f367591..b302ec58 100644 --- a/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs +++ b/massiv/src/Data/Massiv/Array/Manifest/Unboxed.hs @@ -18,6 +18,7 @@ module Data.Massiv.Array.Manifest.Unboxed ( U (..) , Unbox , Array(..) + , MArray(..) , toUnboxedVector , toUnboxedMVector , fromUnboxedVector diff --git a/massiv/src/Data/Massiv/Array/Ops/Construct.hs b/massiv/src/Data/Massiv/Array/Ops/Construct.hs index e15be07a..fdb5d0db 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Construct.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Construct.hs @@ -442,7 +442,8 @@ randomArrayS gen sz nextRandom = -- @since 0.3.4 randomArrayWS :: forall r ix e g m. (Manifest r e, Index ix, MonadUnliftIO m, PrimMonad m) - => WorkerStates g -- ^ Use `initWorkerStates` to initialize you per thread generators + => WorkerStates g + -- ^ Use `Control.Scheduler.initWorkerStates` to initialize you per thread generators -> Sz ix -- ^ Resulting size of the array -> (g -> m e) -- ^ Generate the value using the per thread generator. -> m (Array r ix e) diff --git a/massiv/src/Data/Massiv/Array/Ops/Map.hs b/massiv/src/Data/Massiv/Array/Ops/Map.hs index 89500cbf..caaa8b9e 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Map.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Map.hs @@ -599,9 +599,9 @@ forIO = flip mapIO --- | Same as `imapIO`, but ignores the inner computation strategy and uses stateful --- workers during computation instead. Use `initWorkerStates` for the `WorkerStates` --- initialization. +-- | Same as `imapIO`, but ignores the inner computation strategy and uses +-- stateful workers during computation instead. Use +-- `Control.Scheduler.initWorkerStates` for the `WorkerStates` initialization. -- -- @since 0.3.4 imapWS :: diff --git a/massiv/src/Data/Massiv/Array/Ops/Transform.hs b/massiv/src/Data/Massiv/Array/Ops/Transform.hs index 61d38de8..ed313a52 100644 --- a/massiv/src/Data/Massiv/Array/Ops/Transform.hs +++ b/massiv/src/Data/Massiv/Array/Ops/Transform.hs @@ -64,22 +64,67 @@ module Data.Massiv.Array.Ops.Transform , transform2' ) where +import Control.Monad as M (foldM_, forM_, unless) +import Control.Monad.ST import Control.Scheduler (traverse_) -import Control.Monad as M (foldM_, unless, forM_) import Data.Bifunctor (bimap) -import Data.Foldable as F (foldl', foldrM, toList, length) +import Data.Foldable as F (foldl', foldrM, length, toList) import qualified Data.List as L (uncons) import Data.Massiv.Array.Delayed.Pull import Data.Massiv.Array.Delayed.Push import Data.Massiv.Array.Mutable import Data.Massiv.Array.Ops.Construct import Data.Massiv.Array.Ops.Map -import Data.Massiv.Core.Common -import Prelude as P hiding (concat, splitAt, traverse, mapM_, reverse, take, drop) +import Data.Massiv.Core +import Data.Massiv.Core.Index.Internal +import Data.Massiv.Core.Common (size, unsafeIndex, unsafeResize, evaluate', evaluateM) +import Data.Proxy +import Prelude as P hiding (concat, drop, mapM_, reverse, splitAt, take, + traverse) -- | Extract a sub-array from within a larger source array. Array that is being extracted must be -- fully encapsulated in a source array, otherwise `SizeSubregionException` will be thrown. +-- +-- ====__Examples__ +-- +-- >>> import Data.Massiv.Array as A +-- >>> m <- resizeM (Sz (3 :. 3)) $ Ix1 1 ... 9 +-- >>> m +-- Array D Seq (Sz (3 :. 3)) +-- [ [ 1, 2, 3 ] +-- , [ 4, 5, 6 ] +-- , [ 7, 8, 9 ] +-- ] +-- >>> extractM (0 :. 1) (Sz (2 :. 2)) m +-- Array D Seq (Sz (2 :. 2)) +-- [ [ 2, 3 ] +-- , [ 5, 6 ] +-- ] +-- >>> a <- resizeM (Sz (3 :> 2 :. 4)) $ Ix1 11 ... 34 +-- >>> a +-- Array D Seq (Sz (3 :> 2 :. 4)) +-- [ [ [ 11, 12, 13, 14 ] +-- , [ 15, 16, 17, 18 ] +-- ] +-- , [ [ 19, 20, 21, 22 ] +-- , [ 23, 24, 25, 26 ] +-- ] +-- , [ [ 27, 28, 29, 30 ] +-- , [ 31, 32, 33, 34 ] +-- ] +-- ] +-- >>> extractM (0 :> 1 :. 1) (Sz (3 :> 1 :. 2)) a +-- Array D Seq (Sz (3 :> 1 :. 2)) +-- [ [ [ 16, 17 ] +-- ] +-- , [ [ 24, 25 ] +-- ] +-- , [ [ 32, 33 ] +-- ] +-- ] +-- +-- @since 0.3.0 extractM :: forall r ix e m. (MonadThrow m, Index ix, Source r e) => ix -- ^ Starting index @@ -113,6 +158,31 @@ extract' sIx newSz = throwEither . extractM sIx newSz -- | Similar to `extractM`, except it takes starting and ending index. Result array will not include -- the ending index. -- +-- ====__Examples__ +-- +-- >>> a <- resizeM (Sz (3 :> 2 :. 4)) $ Ix1 11 ... 34 +-- >>> a +-- Array D Seq (Sz (3 :> 2 :. 4)) +-- [ [ [ 11, 12, 13, 14 ] +-- , [ 15, 16, 17, 18 ] +-- ] +-- , [ [ 19, 20, 21, 22 ] +-- , [ 23, 24, 25, 26 ] +-- ] +-- , [ [ 27, 28, 29, 30 ] +-- , [ 31, 32, 33, 34 ] +-- ] +-- ] +-- >>> extractFromToM (1 :> 0 :. 1) (3 :> 2 :. 4) a +-- Array D Seq (Sz (2 :> 2 :. 3)) +-- [ [ [ 20, 21, 22 ] +-- , [ 24, 25, 26 ] +-- ] +-- , [ [ 28, 29, 30 ] +-- , [ 32, 33, 34 ] +-- ] +-- ] +-- -- @since 0.3.0 extractFromToM :: forall r ix e m. (MonadThrow m, Index ix, Source r e) diff --git a/massiv/src/Data/Massiv/Array/Unsafe.hs b/massiv/src/Data/Massiv/Array/Unsafe.hs index 467b4028..35f7f183 100644 --- a/massiv/src/Data/Massiv/Array/Unsafe.hs +++ b/massiv/src/Data/Massiv/Array/Unsafe.hs @@ -90,20 +90,29 @@ module Data.Massiv.Array.Unsafe , unsafeUnstablePartitionRegionM , module Data.Massiv.Vector.Unsafe , module Data.Massiv.Array.Stencil.Unsafe + -- * Constructors + , Array(PArray, SArray, UArray, BArray, BLArray, BNArray, DArray, DLArray, DSArray, DIArray, DWArray) + , MArray(MPArray, MSArray, MUArray, MBArray, MBLArray, MBNArray) ) where -import Data.Massiv.Array.Delayed.Pull (D, unsafeExtract, unsafeSlice, unsafeInnerSlice) -import Data.Massiv.Array.Delayed.Push (unsafeMakeLoadArray, unsafeMakeLoadArrayAdjusted) +import Data.Massiv.Array.Delayed.Interleaved (Array(DIArray)) +import Data.Massiv.Array.Delayed.Pull (D, unsafeExtract, unsafeInnerSlice, + unsafeSlice) +import Data.Massiv.Array.Delayed.Push (Array(DLArray), unsafeMakeLoadArray, + unsafeMakeLoadArrayAdjusted) +import Data.Massiv.Array.Delayed.Stream (Array(DSArray)) +import Data.Massiv.Array.Delayed.Windowed (Array(DWArray)) import Data.Massiv.Array.Manifest.Boxed +import Data.Massiv.Array.Manifest.Internal import Data.Massiv.Array.Manifest.Primitive import Data.Massiv.Array.Manifest.Storable -import Data.Massiv.Array.Manifest.Internal +import Data.Massiv.Array.Manifest.Unboxed import Data.Massiv.Array.Mutable.Internal import Data.Massiv.Array.Ops.Sort (unsafeUnstablePartitionRegionM) +import Data.Massiv.Array.Stencil.Unsafe import Data.Massiv.Core.Common import Data.Massiv.Core.Index.Stride (Stride(SafeStride)) import Data.Massiv.Vector.Unsafe -import Data.Massiv.Array.Stencil.Unsafe unsafeBackpermute :: (Index ix', Source r' e, Index ix) => diff --git a/massiv/src/Data/Massiv/Core.hs b/massiv/src/Data/Massiv/Core.hs index 2571ddf7..9638488e 100644 --- a/massiv/src/Data/Massiv/Core.hs +++ b/massiv/src/Data/Massiv/Core.hs @@ -29,6 +29,8 @@ module Data.Massiv.Core , SchedulerWS , Strategy , Comp(Seq, Par, Par', ParOn, ParN) + , getComp + , setComp , appComp , WorkerStates , initWorkerStates diff --git a/massiv/src/Data/Massiv/Core/Common.hs b/massiv/src/Data/Massiv/Core/Common.hs index cfec2239..d9c16877 100644 --- a/massiv/src/Data/Massiv/Core/Common.hs +++ b/massiv/src/Data/Massiv/Core/Common.hs @@ -260,11 +260,12 @@ lengthHintUpperBound = \case LengthUnknown -> Nothing {-# INLINE lengthHintUpperBound #-} - +-- | Arrays that have information about their size availible in constant +-- time. class Size r where - -- | Get the exact size of an immutabe array. Most of the time will produce - -- the size in constant time, except for `Data.Massiv.Array.DS` + -- | /O(1)/ - Get the exact size of an immutabe array. Most of the time will + -- produce the size in constant time, except for `Data.Massiv.Array.DS` -- representation, which could result in evaluation of the whole stream. See -- `maxLinearSize` and `Data.Massiv.Vector.slength` for more info. -- @@ -273,6 +274,8 @@ class Size r where -- | /O(1)/ - Change the size of an array. Total number of elements should be the same, but it is -- not validated. + -- + -- @since 0.1.0 unsafeResize :: (Index ix, Index ix') => Sz ix' -> Array r ix e -> Array r ix' e diff --git a/massiv/src/Data/Massiv/Core/Index/Internal.hs b/massiv/src/Data/Massiv/Core/Index/Internal.hs index 1d4929b1..3580ae36 100644 --- a/massiv/src/Data/Massiv/Core/Index/Internal.hs +++ b/massiv/src/Data/Massiv/Core/Index/Internal.hs @@ -160,7 +160,7 @@ instance (Num ix, Index ix) => Num (Sz ix) where negate x | x == zeroSz = x | otherwise = - error $ "Attempted to negate: " ++ show x ++ ", this can lead to unexpected behavior. See #114" + error $ "Attempted to negate: " ++ show x ++ ", this can lead to unexpected behavior. See https://github.com/lehins/massiv/issues/114" {-# INLINE negate #-} signum x = SafeSz (signum (coerce x)) {-# INLINE signum #-} From 11604bc78022cfbbc079b62b9bf456e39a1ed89f Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Sun, 1 Aug 2021 02:26:32 +0300 Subject: [PATCH 65/65] Remove Azure CI --- .azure/job.yml | 118 ------------------------------------------- .azure/pipelines.yml | 58 --------------------- 2 files changed, 176 deletions(-) delete mode 100644 .azure/job.yml delete mode 100644 .azure/pipelines.yml diff --git a/.azure/job.yml b/.azure/job.yml deleted file mode 100644 index 19916a69..00000000 --- a/.azure/job.yml +++ /dev/null @@ -1,118 +0,0 @@ -parameters: -- name: setupEnvironmentSteps - displayName: 'Setup stack and all other pre-build stuff' - type: stepList - default: [] -- name: jobName - type: string -- name: vmImage - type: string -- name: os - type: string -- name: stackRoot - default: "$(System.DefaultWorkingDirectory)/.stack" -- name: stackWork - default: ".stack-work" -- name: stackProjectPath - displayName: "Path to the project." - default: "$(Build.SourcesDirectory)" - -jobs: -- job: ${{ parameters.jobName }} - timeoutInMinutes: 120 - variables: - STACK_ROOT: "${{ parameters.stackRoot }}" - STACK_WORK: "${{ parameters.stackWork }}" - BUILD_ARGS: "-j 2 --no-terminal --bench --no-run-benchmarks" - pool: - vmImage: ${{ parameters.vmImage }} - strategy: - matrix: - lts-12.14: - RESOLVER: "lts-12.14" # ghc-8.4.3 - STACK_YAML: "stack-extra-deps.yaml" - lts-12.26: - RESOLVER: "lts-12.26" # ghc-8.4.4 - STACK_YAML: "stack-extra-deps.yaml" - lts-13.30: - RESOLVER: "lts-13.30" # ghc-8.6.5 - STACK_YAML: "stack-extra-deps.yaml" - lts-14.27: - RESOLVER: "lts-14.27" # ghc-8.6.5 - STACK_YAML: "stack-extra-deps.yaml" - lts-16.31: - RESOLVER: "lts-16.31" # ghc-8.8.4 - # lts-15: - # RESOLVER: "lts-15" # ghc-8.8.3 - # nightly: - # RESOLVER: "nightly" - maxParallel: 5 - steps: - - task: Cache@2 - displayName: Cache STACK_ROOT - inputs: - key: '"${{ parameters.jobName }}" | "STACK_ROOT" | "$(RESOLVER)" | "$(Build.SourceBranch)"' - path: "$(STACK_ROOT)" - restoreKeys: | - "${{ parameters.jobName }}" | "STACK_ROOT" | "$(RESOLVER)" | "$(Build.SourceBranch)" - "${{ parameters.jobName }}" | "STACK_ROOT" | "$(RESOLVER)" | "refs/heads/master" - cacheHitVar: STACK_ROOT_RESTORED - continueOnError: true - - task: Cache@2 - displayName: Cache STACK_WORK - inputs: - key: '"${{ parameters.jobName }}" | "STACK_WORK" | "$(RESOLVER)" | "$(Build.SourceBranch)"' - path: "${{ parameters.stackProjectPath }}/${{ parameters.stackWork }}" - restoreKeys: | - "${{ parameters.jobName }}" | "STACK_WORK" | "$(RESOLVER)" | "$(Build.SourceBranch)" - "${{ parameters.jobName }}" | "STACK_WORK" | "$(RESOLVER)" | "refs/heads/master" - cacheHitVar: STACK_WORK_RESTORED - continueOnError: true - - task: Cache@2 - displayName: Cache STACK_WORK massiv - inputs: - key: '"${{ parameters.jobName }}" | "massiv" | "$(RESOLVER)" | "$(Build.SourceBranch)"' - path: "${{ parameters.stackProjectPath }}/massiv/${{ parameters.stackWork }}" - restoreKeys: | - "${{ parameters.jobName }}" | "massiv/.stack-work" | "$(RESOLVER)" | "$(Build.SourceBranch)" - "${{ parameters.jobName }}" | "massiv/.stack-work" | "$(RESOLVER)" | "refs/heads/master" - continueOnError: true - - task: Cache@2 - displayName: Cache STACK_WORK massiv-test - inputs: - key: '"${{ parameters.jobName }}" | "massiv-test" | "$(RESOLVER)" | "$(Build.SourceBranch)"' - path: "${{ parameters.stackProjectPath }}/massiv-test/${{ parameters.stackWork }}" - restoreKeys: | - "${{ parameters.jobName }}" | "massiv-test/.stack-work" | "$(RESOLVER)" | "$(Build.SourceBranch)" - "${{ parameters.jobName }}" | "massiv-test/.stack-work" | "$(RESOLVER)" | "refs/heads/master" - continueOnError: true - - ${{ each step in parameters.setupEnvironmentSteps }}: - - ${{ each pair in step }}: - ${{ pair.key }}: ${{ pair.value }} - - task: Bash@3 - displayName: 'stack build' - env: - ARGS: "--resolver $(RESOLVER)" - inputs: - targetType: 'inline' - script: | - set -x - ./stack ${ARGS} test --no-run-tests ${BUILD_ARGS} --haddock --no-haddock-deps - - task: Bash@3 - displayName: 'massiv-test:tests' - env: - ARGS: "--resolver $(RESOLVER)" - inputs: - targetType: 'inline' - script: | - set -x - ./stack ${ARGS} test massiv-test:tests ${BUILD_ARGS} - - task: Bash@3 - displayName: 'massiv:doctests' - env: - ARGS: "--resolver $(RESOLVER)" - inputs: - targetType: 'inline' - script: | - set -x - ./stack ${ARGS} test massiv:doctests ${BUILD_ARGS} diff --git a/.azure/pipelines.yml b/.azure/pipelines.yml deleted file mode 100644 index fe9e5e87..00000000 --- a/.azure/pipelines.yml +++ /dev/null @@ -1,58 +0,0 @@ -jobs: -# - template: ./job.yml -# parameters: -# jobName: macOS -# vmImage: macOS-latest -# os: osx -# setupEnvironmentSteps: -# - task: Bash@3 -# displayName: Setup environment -# inputs: -# targetType: 'inline' -# script: | -# set -x -# # Install stack -# curl -L https://www.stackage.org/stack/osx-x86_64 | tar xz --strip-components=1 --include '*/stack' -C . -# # Script for restoring source files modification time from commit to avoid recompilation. -# curl -sSkL https://gist.githubusercontent.com/lehins/fd36a8cc8bf853173437b17f6b6426ad/raw/4702d0252731ad8b21317375e917124c590819ce/git-modtime.hs -o git-modtime.hs -# # Restore mod time and setup ghc, if it wasn't restored from cache -# ./stack script --resolver ${RESOLVER} git-modtime.hs --package base --package time --package directory --package process - -# For faster CI turnaround, linux builds are still on Travis -# - template: ./linux.yml -# parameters: -# jobName: Linux -# vmImage: ubuntu-latest -# os: linux - -- template: ./job.yml - parameters: - jobName: Windows - vmImage: windows-latest - os: windows - stackRoot: "$(System.DefaultWorkingDirectory)\\s" - stackWork: ".w" - stackProjectPath: "$(Build.SourcesDirectory)" - setupEnvironmentSteps: - - powershell: | - xcopy "$env:STACK_ROOT\\bin" "$env:LOCALAPPDATA\\Programs\\stack" /f /s /r /k /i /h /y /b - displayName: Restore binaries - condition: eq(variables.STACK_ROOT_RESTORED, 'true') - continueOnError: true - - task: Bash@3 - displayName: Setup environment - inputs: - targetType: 'inline' - script: | - set -x - # Install stack - curl -sSkL https://www.stackage.org/stack/windows-x86_64 -o stack.zip - 7z x stack.zip stack.exe -aoa - # Script for restoring source files modification time from commit to avoid recompilation. - curl -sSkL https://gist.githubusercontent.com/lehins/fd36a8cc8bf853173437b17f6b6426ad/raw/4702d0252731ad8b21317375e917124c590819ce/git-modtime.hs -o git-modtime.hs - # Restore mod time and setup ghc, if it wasn't restored from cache - ./stack script --resolver ${RESOLVER} git-modtime.hs --package base --package time --package directory --package process - - powershell: | - xcopy "$env:LOCALAPPDATA\\Programs\\stack" "$env:STACK_ROOT\\bin" /f /s /r /k /i /h /y /b - displayName: Save binaries - continueOnError: true