massiv 0.3.0.0 → 0.3.0.1
raw patch · 10 files changed
+59/−71 lines, 10 filesdep ~schedulerPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: scheduler
API changes (from Hackage documentation)
Files
- massiv.cabal +5/−6
- src/Data/Massiv/Array/Delayed/Interleaved.hs +8/−9
- src/Data/Massiv/Array/Delayed/Windowed.hs +19/−16
- src/Data/Massiv/Array/Manifest/Internal.hs +2/−3
- src/Data/Massiv/Array/Mutable.hs +4/−4
- src/Data/Massiv/Array/Ops/Construct.hs +3/−3
- src/Data/Massiv/Array/Ops/Transform.hs +5/−6
- src/Data/Massiv/Core/Iterator.hs +9/−9
- src/Data/Massiv/Core/List.hs +4/−5
- tests/Data/Massiv/Core/SchedulerSpec.hs +0/−10
massiv.cabal view
@@ -1,5 +1,5 @@ name: massiv-version: 0.3.0.0+version: 0.3.0.1 synopsis: Massiv (Массив) is an Array Library. description: Multi-dimensional Arrays with fusion, stencils and parallel computation. homepage: https://github.com/lehins/massiv@@ -23,7 +23,7 @@ setup-depends: base , Cabal- , cabal-doctest >=1.0.6+ , cabal-doctest >=1.0.6 library hs-source-dirs: src@@ -67,12 +67,12 @@ , Data.Massiv.Core.Index.Tuple , Data.Massiv.Core.Iterator , Data.Massiv.Core.List- build-depends: base >= 4.9 && < 5+ build-depends: base >= 4.9 && < 5 , bytestring , data-default-class , deepseq , exceptions- , scheduler+ , scheduler >= 1.1.0 , primitive , unliftio-core , vector@@ -117,7 +117,6 @@ , data-default , deepseq , massiv- , scheduler , hspec , QuickCheck , unliftio@@ -137,7 +136,7 @@ hs-source-dirs: tests main-is: doctests.hs build-depends: base- , doctest >=0.15+ , doctest >=0.15 , QuickCheck , massiv , template-haskell
src/Data/Massiv/Array/Delayed/Interleaved.hs view
@@ -3,7 +3,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -- |@@ -60,19 +59,19 @@ {-# INLINE size #-} getComp = dComp . diArray {-# INLINE getComp #-}- loadArrayM Scheduler {numWorkers, scheduleWork} (DIArray (DArray _ sz f)) uWrite =- loopM_ 0 (< numWorkers) (+ 1) $ \ !start ->- scheduleWork $- iterLinearM_ sz start (totalElem sz) numWorkers (<) $ \ !k -> uWrite k . f+ loadArrayM 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 #-} instance Index ix => StrideLoad DI ix e where- loadArrayWithStrideM Scheduler {numWorkers, scheduleWork} stride resultSize arr uWrite =+ loadArrayWithStrideM scheduler stride resultSize arr uWrite = let strideIx = unStride stride DIArray (DArray _ _ f) = arr- in loopM_ 0 (< numWorkers) (+ 1) $ \ !start ->- scheduleWork $- iterLinearM_ resultSize start (totalElem resultSize) numWorkers (<) $+ 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 #-}
src/Data/Massiv/Array/Delayed/Windowed.hs view
@@ -27,6 +27,7 @@ ) where import Control.Exception (Exception(..))+import Control.Scheduler (trivialScheduler_) import Control.Monad (when) import Data.Massiv.Array.Delayed.Pull import Data.Massiv.Array.Manifest.Boxed@@ -223,26 +224,26 @@ {-# INLINE size #-} getComp = dComp . dwArray {-# INLINE getComp #-}- loadArrayM Scheduler {numWorkers, scheduleWork} arr uWrite = do- (loadWindow, wStart, wEnd) <- loadWithIx1 scheduleWork arr uWrite- let (chunkWidth, slackWidth) = (wEnd - wStart) `quotRem` numWorkers- loopM_ 0 (< numWorkers) (+ 1) $ \ !wid ->+ loadArrayM 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 -> let !it' = wid * chunkWidth + wStart in loadWindow it' (it' + chunkWidth) when (slackWidth > 0) $- let !itSlack = numWorkers * chunkWidth + wStart+ let !itSlack = numWorkers scheduler * chunkWidth + wStart in loadWindow itSlack (itSlack + slackWidth) {-# INLINE loadArrayM #-} instance StrideLoad DW Ix1 e where- loadArrayWithStrideM Scheduler {numWorkers, scheduleWork} stride sz arr uWrite = do- (loadWindow, (wStart, wEnd)) <- loadArrayWithIx1 scheduleWork arr stride sz uWrite- let (chunkWidth, slackWidth) = (wEnd - wStart) `quotRem` numWorkers- loopM_ 0 (< numWorkers) (+ 1) $ \ !wid ->+ loadArrayWithStrideM 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 -> let !it' = wid * chunkWidth + wStart in loadWindow (it', it' + chunkWidth) when (slackWidth > 0) $- let !itSlack = numWorkers * chunkWidth + wStart+ let !itSlack = numWorkers scheduler * chunkWidth + wStart in loadWindow (itSlack, itSlack + slackWidth) {-# INLINE loadArrayWithStrideM #-} @@ -347,13 +348,15 @@ {-# INLINE size #-} getComp = dComp . dwArray {-# INLINE getComp #-}- loadArrayM Scheduler {numWorkers, scheduleWork} arr uWrite =- loadWithIx2 scheduleWork arr uWrite >>= uncurry (loadWindowIx2 numWorkers)+ loadArrayM scheduler arr uWrite =+ loadWithIx2 (scheduleWork scheduler) arr uWrite >>=+ uncurry (loadWindowIx2 (numWorkers scheduler)) {-# INLINE loadArrayM #-} instance StrideLoad DW Ix2 e where- loadArrayWithStrideM Scheduler {numWorkers, scheduleWork} stride sz arr uWrite =- loadArrayWithIx2 scheduleWork arr stride sz uWrite >>= uncurry (loadWindowIx2 numWorkers)+ loadArrayWithStrideM scheduler stride sz arr uWrite =+ loadArrayWithIx2 (scheduleWork scheduler) arr stride sz uWrite >>=+ uncurry (loadWindowIx2 (numWorkers scheduler)) {-# INLINE loadArrayWithStrideM #-} @@ -362,7 +365,7 @@ {-# INLINE size #-} getComp = dComp . dwArray {-# INLINE getComp #-}- loadArrayM Scheduler {scheduleWork} = loadWithIxN scheduleWork+ loadArrayM scheduler = loadWithIxN (scheduleWork scheduler) {-# INLINE loadArrayM #-} instance (Index (IxN n), StrideLoad DW (Ix (n - 1)) e) => StrideLoad DW (IxN n) e where@@ -442,7 +445,7 @@ { dwArray = DArray Seq szL (indexBorder . consDim i) , dwWindow = Just lowerWindow }- in with $ loadArrayM (Scheduler 1 id) lowerArr (\k -> uWrite (k + pageElements * i))+ in with $ loadArrayM trivialScheduler_ lowerArr (\k -> uWrite (k + pageElements * i)) {-# NOINLINE loadLower #-} loopM_ 0 (< headDim windowStart) (+ 1) loadLower loopM_ t (< headDim windowEnd) (+ 1) loadLower
src/Data/Massiv/Array/Manifest/Internal.hs view
@@ -4,7 +4,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}@@ -335,8 +334,8 @@ unsafePerformIO $ do marr <- unsafeNew sz traverse (\_ -> unsafeFreeze (getComp arr) marr) =<<- try (withScheduler_ (getComp arr) $ \Scheduler {scheduleWork} ->- loadRagged scheduleWork (unsafeLinearWrite marr) 0 (totalElem sz) sz arr)+ try (withScheduler_ (getComp arr) $ \scheduler ->+ loadRagged (scheduleWork scheduler) (unsafeLinearWrite marr) 0 (totalElem sz) sz arr) {-# INLINE fromRaggedArrayM #-}
src/Data/Massiv/Array/Mutable.hs view
@@ -75,9 +75,9 @@ , loadArrayS ) where +import Control.Scheduler import Control.Monad (unless) import Control.Monad.ST-import Control.Scheduler import Data.Massiv.Core.Common import Prelude hiding (mapM, read) @@ -207,7 +207,7 @@ -> m (MArray (PrimState m) r ix e) loadArrayS arr = do marr <- unsafeNew (size arr)- loadArrayM (Scheduler 1 id) arr (unsafeLinearWrite marr)+ loadArrayM trivialScheduler_ arr (unsafeLinearWrite marr) pure marr {-# INLINE loadArrayS #-} @@ -528,7 +528,7 @@ unfoldrPrimM_ comp sz gen acc0 = snd <$> unfoldrPrimM comp sz gen acc0 {-# INLINE unfoldrPrimM_ #-} --- | Same as `unfoldrPrim_` but do the unfolding with index aware function.+-- | Same as `unfoldrPrimM_` but do the unfolding with index aware function. -- -- @since 0.3.0 --@@ -543,7 +543,7 @@ {-# INLINE iunfoldrPrimM_ #-} --- | Just like `iunfoldrPrim_`, but also returns the final value of the accumulator.+-- | Just like `iunfoldrPrimM_`, but also returns the final value of the accumulator. -- -- @since 0.3.0 iunfoldrPrimM ::
src/Data/Massiv/Array/Ops/Construct.hs view
@@ -212,7 +212,7 @@ -- | Unfold sequentially from the end. There is no way to save the accumulator after unfolding is -- done, since resulting array is delayed, but it's possible to use--- `Data.Massiv.Array.Mutable.unfoldlPrim` to achive such effect.+-- `Data.Massiv.Array.Mutable.unfoldlPrimM` to achive such effect. -- -- @since 0.3.0 unfoldlS_ :: Construct DL ix e => Comp -> Sz ix -> (a -> (a, e)) -> a -> Array DL ix e@@ -249,7 +249,7 @@ (...) = rangeInclusive Seq {-# INLINE (...) #-} --- | Handy synonym for `rangeInclusive` `Seq`+-- | Handy synonym for `range` `Seq` -- -- >>> 4 ..: 10 -- Array D Seq (Sz1 6)@@ -264,7 +264,7 @@ -- prop> range comp from to == rangeStep comp from 1 to -- -- | Create an array of indices with a range from start to finish (not-including), where indices are--- incrimeted by one.+-- incremeted by one. -- -- ==== __Examples__ --
src/Data/Massiv/Array/Ops/Transform.hs view
@@ -2,7 +2,6 @@ {-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} -- |@@ -487,11 +486,11 @@ { dlComp = getComp arr1 <> getComp arr2 , dlSize = newSz , dlLoad =- \Scheduler{scheduleWork} startAt dlWrite -> do- scheduleWork $+ \scheduler startAt dlWrite -> do+ scheduleWork scheduler $ iterM_ zeroIndex (unSz sz1) (pureIndex 1) (<) $ \ix -> dlWrite (startAt + toLinearIndex newSz ix) (unsafeIndex arr1 ix)- scheduleWork $+ scheduleWork scheduler $ iterM_ zeroIndex (unSz sz2) (pureIndex 1) (<) $ \ix -> let i = getDim' ix n ix' = setDim' ix n (i + k1')@@ -550,9 +549,9 @@ { dlComp = mconcat $ P.map getComp arrs , dlSize = newSz , dlLoad =- \Scheduler{scheduleWork} startAt dlWrite ->+ \scheduler startAt dlWrite -> let arrayLoader !kAcc (kCur, arr) = do- scheduleWork $+ scheduleWork scheduler $ iterM_ zeroIndex (unSz (size arr)) (pureIndex 1) (<) $ \ix -> let i = getDim' ix n ix' = setDim' ix n (i + kAcc)
src/Data/Massiv/Core/Iterator.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE BangPatterns #-} -- | -- Module : Data.Massiv.Core.Iterator@@ -125,11 +124,11 @@ -- @since 0.2.6.0 splitLinearlyWithM_ :: Monad m => Scheduler m () -> Int -> (Int -> m b) -> (Int -> b -> m c) -> m ()-splitLinearlyWithM_ Scheduler {numWorkers, scheduleWork} totalLength make write =- splitLinearly numWorkers totalLength $ \chunkLength slackStart -> do+splitLinearlyWithM_ scheduler totalLength make write =+ splitLinearly (numWorkers scheduler) totalLength $ \chunkLength slackStart -> do loopM_ 0 (< slackStart) (+ chunkLength) $ \ !start ->- scheduleWork $ loopM_ start (< (start + chunkLength)) (+ 1) $ \ !k -> make k >>= write k- scheduleWork $ loopM_ slackStart (< totalLength) (+ 1) $ \ !k -> make k >>= write k+ scheduleWork scheduler $ loopM_ start (< (start + chunkLength)) (+ 1) $ \ !k -> make k >>= write k+ scheduleWork scheduler $ loopM_ slackStart (< totalLength) (+ 1) $ \ !k -> make k >>= write k {-# INLINE splitLinearlyWithM_ #-} @@ -138,11 +137,12 @@ -- @since 0.2.6.0 splitLinearlyWithStartAtM_ :: Monad m => Scheduler m () -> Int -> Int -> (Int -> m b) -> (Int -> b -> m c) -> m ()-splitLinearlyWithStartAtM_ Scheduler {numWorkers, scheduleWork} startAt totalLength make write =- splitLinearly numWorkers totalLength $ \chunkLength slackStart -> do+splitLinearlyWithStartAtM_ scheduler startAt totalLength make write =+ splitLinearly (numWorkers scheduler) totalLength $ \chunkLength slackStart -> do loopM_ startAt (< (slackStart + startAt)) (+ chunkLength) $ \ !start ->- scheduleWork $ loopM_ start (< (start + chunkLength)) (+ 1) $ \ !k -> make k >>= write k- scheduleWork $+ scheduleWork scheduler $+ loopM_ start (< (start + chunkLength)) (+ 1) $ \ !k -> make k >>= write k+ scheduleWork scheduler $ loopM_ (slackStart + startAt) (< (totalLength + startAt)) (+ 1) $ \ !k -> make k >>= write k {-# INLINE splitLinearlyWithStartAtM_ #-}
src/Data/Massiv/Core/List.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE NamedFieldPuns #-}-{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}@@ -9,6 +7,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} -- | -- Module : Data.Massiv.Core.List -- Copyright : (c) Alexey Kuleshevich 2018-2019@@ -28,8 +27,8 @@ ) where import Control.Exception-import Control.Scheduler import Control.Monad (unless, when)+import Control.Scheduler import Data.Coerce import Data.Foldable (foldr') import qualified Data.List as L@@ -140,8 +139,8 @@ {-# INLINE size #-} getComp = lComp {-# INLINE getComp #-}- loadArrayM Scheduler {scheduleWork} arr uWrite =- loadRagged scheduleWork uWrite 0 (totalElem sz) sz arr+ loadArrayM scheduler arr uWrite =+ loadRagged (scheduleWork scheduler) uWrite 0 (totalElem sz) sz arr where !sz = edgeSize arr {-# INLINE loadArrayM #-}
tests/Data/Massiv/Core/SchedulerSpec.hs view
@@ -3,7 +3,6 @@ module Data.Massiv.Core.SchedulerSpec (spec) where import Control.Exception.Base (ArithException(DivideByZero))-import Control.Scheduler import Data.Massiv.CoreArbitrary as A import Prelude as P @@ -41,17 +40,8 @@ (setComp (ParOn caps) arr)) --- | Check weather all jobs have been completed and returned order is correct-prop_SchedulerAllJobsProcessed :: Comp -> OrderedList Int -> Property-prop_SchedulerAllJobsProcessed comp (Ordered jobs) =- monadicIO- ((=== jobs) <$>- run (withScheduler comp $ \scheduler -> P.mapM_ (scheduleWork scheduler . return) jobs))-- spec :: Spec spec = describe "Exceptions" $ do it "CatchDivideByZero" $ property prop_CatchDivideByZero it "CatchNested" $ property prop_CatchNested- it "SchedulerAllJobsProcessed" $ property prop_SchedulerAllJobsProcessed