packages feed

massiv 0.1.0.0 → 0.1.1.0

raw patch · 23 files changed

+682/−178 lines, 23 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

+ Data.Massiv.Array: computeProxy :: (Load r' ix e, Mutable r ix e) => proxy r -> Array r' ix e -> Array r ix e
+ Data.Massiv.Array: convertProxy :: (Mutable r' ix e, Mutable r ix e, Typeable ix, Typeable e) => proxy r -> Array r' ix e -> Array r ix e
+ Data.Massiv.Array: fromRaggedArray :: (Ragged r' ix e, Mutable r ix e) => Array r' ix e -> Either ShapeError (Array r ix e)
+ Data.Massiv.Array: fromRaggedArray' :: (Ragged r' ix e, Mutable r ix e) => Array r' ix e -> Array r ix e
+ Data.Massiv.Array.Mutable: forM :: (Monad m, Source r ix e, Mutable r' ix e') => r' -> Array r ix e -> (e -> m e') -> m (Array r' ix e')
+ Data.Massiv.Array.Mutable: generateLinearM :: (Monad m, Mutable r ix e) => Comp -> ix -> (Int -> m e) -> m (Array r ix e)
+ Data.Massiv.Array.Mutable: generateM :: (Monad m, Mutable r ix e) => Comp -> ix -> (ix -> m e) -> m (Array r ix e)
+ Data.Massiv.Array.Mutable: iforM :: (Monad m, Source r ix e, Mutable r' ix e') => r' -> Array r ix e -> (ix -> e -> m e') -> m (Array r' ix e')
+ Data.Massiv.Array.Mutable: imapM :: (Monad m, Source r ix e, Mutable r' ix e') => r' -> (ix -> e -> m e') -> Array r ix e -> m (Array r' ix e')
+ Data.Massiv.Array.Mutable: mapM :: (Monad m, Source r ix e, Mutable r' ix e') => r' -> (e -> m e') -> Array r ix e -> m (Array r' ix e')
+ Data.Massiv.Array.Mutable: sequenceM :: (Monad m, Source r ix (m e), Mutable r' ix e) => r' -> Array r ix (m e) -> m (Array r' ix e)
+ Data.Massiv.Core.Index: loopDeepM :: Monad m => Int -> (Int -> Bool) -> (Int -> Int) -> a -> (Int -> a -> m a) -> m a

Files

README.md view
@@ -1,2 +1,10 @@ # massiv+ Efficient Haskell Arrays featuring Parallel computation++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.++See [massiv-io](https://hackage.haskell.org/package/massiv-io) for ability to read/write images.++
massiv.cabal view
@@ -1,5 +1,5 @@ name:                massiv-version:             0.1.0.0+version:             0.1.1.0 synopsis:            Massiv (Массив) is an Array Library. description:         Multi-dimensional Arrays with fusion, stencils and parallel computation. homepage:            https://github.com/lehins/massiv@@ -50,7 +50,7 @@                      , Data.Massiv.Core.Index.Ix                      , Data.Massiv.Core.Iterator                      , Data.Massiv.Core.List-  build-depends:       base            >= 4.7 && < 5+  build-depends:       base            >= 4.8 && < 5                      , data-default-class                      , deepseq                      , ghc-prim@@ -66,6 +66,7 @@   Main-Is:            Spec.hs   Other-Modules:      Data.Massiv.Array.DelayedSpec                     , Data.Massiv.Array.Manifest.VectorSpec+                    , Data.Massiv.Array.MutableSpec                     , Data.Massiv.Array.Ops.ConstructSpec                     , Data.Massiv.Array.Ops.FoldSpec                     , Data.Massiv.Array.Ops.SliceSpec@@ -74,7 +75,7 @@                     , Data.Massiv.CoreArbitrary                     , Data.Massiv.Core.IndexSpec                     , Data.Massiv.Core.SchedulerSpec-  Build-Depends:      base            >= 4.5 && < 5+  Build-Depends:      base            >= 4.8 && < 5                     , deepseq                     , data-default                     , safe-exceptions
src/Data/Massiv/Array.hs view
@@ -76,10 +76,14 @@   , setComp   , compute   , computeAs+  , computeProxy   , computeSource   , clone   , convert   , convertAs+  , convertProxy+  , fromRaggedArray+  , fromRaggedArray'   -- * Size   , size   , Core.elemsCount@@ -106,6 +110,8 @@   , module Data.Massiv.Array.Ops.Slice   -- * Conversion   , module Data.Massiv.Array.Manifest.List+  -- * Mutable+  , module Data.Massiv.Array.Mutable   -- * Core   , module Data.Massiv.Core   -- * Representations@@ -118,10 +124,10 @@  import           Data.Massiv.Array.Delayed import           Data.Massiv.Array.Manifest-import           Data.Massiv.Array.Numeric import           Data.Massiv.Array.Manifest.Internal import           Data.Massiv.Array.Manifest.List-import           Data.Massiv.Array.Mutable           as A+import           Data.Massiv.Array.Mutable+import           Data.Massiv.Array.Numeric import           Data.Massiv.Array.Ops.Construct import           Data.Massiv.Array.Ops.Fold import           Data.Massiv.Array.Ops.Map@@ -134,10 +140,10 @@                                                               isEmpty) import           Data.Massiv.Core.Common import           Prelude                             as P hiding (all, and, any,-                                                           foldl, foldr,-                                                           maximum, minimum, or,-                                                           product, splitAt,-                                                           sum)+                                                           foldl, foldr, mapM,+                                                           mapM_, maximum,+                                                           minimum, or, product,+                                                           splitAt, sum) {- $folding  All folding is done in a row-major order.
src/Data/Massiv/Array/Delayed/Internal.hs view
@@ -17,6 +17,7 @@   , Array(..)   , delay   , eq+  , ord   , liftArray   , liftArray2   ) where@@ -95,6 +96,9 @@   (==) = eq (==)   {-# INLINE (==) #-} +instance (Ord e, Index ix) => Ord (Array D ix e) where+  compare = ord compare+  {-# INLINE compare #-}  instance Functor (Array D ix) where   fmap f (DArray c sz g) = DArray c sz (f . g)@@ -217,6 +221,20 @@     (DArray (getComp arr1 <> getComp arr2) (size arr1) $ \ix ->        f (unsafeIndex arr1 ix) (unsafeIndex arr2 ix)) {-# INLINE eq #-}++-- | /O(n1 + n2)/ - 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.+ord :: (Source r1 ix e1, Source r2 ix e2) =>+       (e1 -> e2 -> Ordering) -> Array r1 ix e1 -> Array r2 ix e2 -> Ordering+ord f arr1 arr2 =+  (compare (size arr1) (size arr2)) <>+  A.fold+    (<>)+    mempty+    (DArray (getComp arr1 <> getComp arr2) (size arr1) $ \ix ->+       f (unsafeIndex arr1 ix) (unsafeIndex arr2 ix))+{-# INLINE ord #-}   liftArray :: Source r ix b => (b -> e) -> Array r ix b -> Array D ix e
src/Data/Massiv/Array/Manifest/BoxedNF.hs view
@@ -25,7 +25,7 @@  import           Control.DeepSeq                     (NFData (..), deepseq) import           Control.Monad.ST                    (runST)-import           Data.Massiv.Array.Delayed.Internal  (eq)+import           Data.Massiv.Array.Delayed.Internal  (eq, ord) import           Data.Massiv.Array.Manifest.Internal (M, toManifest) import           Data.Massiv.Array.Manifest.List     as A import           Data.Massiv.Array.Mutable@@ -63,6 +63,10 @@ instance (Index ix, NFData e, Eq e) => Eq (Array N ix e) where   (==) = eq (==)   {-# INLINE (==) #-}++instance (Index ix, NFData e, Ord e) => Ord (Array N ix e) where+  compare = ord compare+  {-# INLINE compare #-}   instance (Index ix, NFData e) => Construct N ix e where
src/Data/Massiv/Array/Manifest/BoxedStrict.hs view
@@ -20,7 +20,7 @@  import           Control.DeepSeq                     (NFData (..)) import qualified Data.Foldable                       as F (Foldable (..))-import           Data.Massiv.Array.Delayed.Internal  (eq)+import           Data.Massiv.Array.Delayed.Internal  (eq, ord) import           Data.Massiv.Array.Manifest.BoxedNF  (deepseqArray,                                                       deepseqArrayP) import           Data.Massiv.Array.Unsafe            (unsafeGenerateArray,@@ -57,6 +57,10 @@ instance (Index ix, Eq e) => Eq (Array B ix e) where   (==) = eq (==)   {-# INLINE (==) #-}++instance (Index ix, Ord e) => Ord (Array B ix e) where+  compare = ord compare+  {-# INLINE compare #-}  instance Index ix => Construct B ix e where   getComp = bComp
src/Data/Massiv/Array/Manifest/Internal.hs view
@@ -22,10 +22,12 @@   , toManifest   , compute   , computeAs+  , computeProxy   , computeSource   , clone   , convert   , convertAs+  , convertProxy   , gcastArr   , loadMutableS   , loadMutableOnP@@ -40,7 +42,6 @@ import           Data.Foldable                      (Foldable (..)) import           Data.Massiv.Array.Delayed.Internal import           Data.Massiv.Array.Ops.Fold         as M-import           Data.Massiv.Array.Ops.Map          (iforM_) import           Data.Massiv.Array.Unsafe import           Data.Massiv.Core.Common import           Data.Massiv.Core.List@@ -213,11 +214,36 @@ {-# INLINE compute #-}  -- | Just as `compute`, but let's you supply resulting representation type as an argument.+--+-- ====__Examples__+--+-- >>> computeAs P $ range Seq 0 10+-- (Array P Seq (10)+--   [ 0,1,2,3,4,5,6,7,8,9 ])+-- computeAs :: (Load r' ix e, Mutable r ix e) => r -> Array r' ix e -> Array r ix e computeAs _ = compute {-# INLINE computeAs #-}  +-- | Same as `convert` and `convertAs`, but let's you supply resulting representation type as a proxy+-- argument.+--+-- @since 0.1.1+--+-- ====__Examples__+--+-- Useful for cases when representation constructor isn't available for some reason:+--+-- >>> computeProxy (Nothing :: Maybe P) $ range Seq 0 10+-- (Array P Seq (10)+--   [ 0,1,2,3,4,5,6,7,8,9 ])+--+computeProxy :: (Load r' ix e, Mutable r ix e) => proxy r -> Array r' ix e -> Array r ix e+computeProxy _ = compute+{-# INLINE computeProxy #-}++ -- | This is just like `compute`, but can be applied to `Source` arrays and will be a noop if -- resulting type is the same as the input. computeSource :: forall r' r ix e . (Source r' ix e, Mutable r ix e)@@ -254,12 +280,22 @@ {-# INLINE convertAs #-}  +-- | Same as `convert` and `convertAs`, but let's you supply resulting representation type as a+-- proxy argument.+--+-- @since 0.1.1+--+convertProxy :: (Mutable r' ix e, Mutable r ix e, Typeable ix, Typeable e)+             => proxy r -> Array r' ix e -> Array r ix e+convertProxy _ = convert+{-# INLINE convertProxy #-}+ sequenceOnP :: (Source r1 ix (IO e), Mutable r ix e) =>                [Int] -> Array r1 ix (IO e) -> IO (Array r ix e) sequenceOnP wIds !arr = do   resArrM <- unsafeNew (size arr)   withScheduler_ wIds $ \scheduler ->-    iforM_ arr $ \ !ix action ->+    flip imapM_ arr $ \ !ix action ->       scheduleWork scheduler $ action >>= unsafeWrite resArrM ix   unsafeFreeze (getComp arr) resArrM {-# INLINE sequenceOnP #-}@@ -270,41 +306,22 @@ {-# INLINE sequenceP #-}  ------ sequenceOnP' :: (NFData e, Source r1 ix (IO e), Mutable r ix e) =>---                [Int] -> Array r1 ix (IO e) -> IO (Array r ix e)--- sequenceOnP' wIds !arr = do---   resArrM <- unsafeNew (size arr)---   scheduler <- makeScheduler wIds---   iforM_ arr $ \ !ix action ->---     submitRequest scheduler $ JobRequest $ do---       res <- action---       res `deepseq` unsafeWrite resArrM ix res---   waitTillDone scheduler---   unsafeFreeze resArrM--- {-# INLINE sequenceOnP' #-}----- sequenceP' :: (NFData e, Source r1 ix (IO e), Mutable r ix e)---            => Array r1 ix (IO e) -> IO (Array r ix e)--- sequenceP' = sequenceOnP' []--- {-# INLINE sequenceP' #-}- -- | Convert a ragged array into a usual rectangular shaped one. fromRaggedArray :: (Ragged r' ix e, Mutable r ix e) =>                    Array r' ix e -> Either ShapeError (Array r ix e)-fromRaggedArray arr = unsafePerformIO $ do-  let sz = edgeSize arr-  mArr <- unsafeNew sz-  let loadWith using =-        loadRagged using (unsafeLinearWrite mArr) 0 (totalElem sz) (tailDim sz) arr-  try $ case getComp arr of-          Seq -> loadWith id >> unsafeFreeze (getComp arr) mArr-          ParOn ss -> do-            withScheduler_ ss (loadWith . scheduleWork)-            unsafeFreeze (getComp arr) mArr+fromRaggedArray arr =+  unsafePerformIO $ do+    let sz = edgeSize arr+    mArr <- unsafeNew sz+    let loadWith using = loadRagged using (unsafeLinearWrite mArr) 0 (totalElem sz) (tailDim sz) arr+    try $+      case getComp arr of+        Seq -> do+          loadWith id+          unsafeFreeze Seq mArr+        pComp@(ParOn ss) -> do+          withScheduler_ ss (loadWith . scheduleWork)+          unsafeFreeze pComp mArr {-# INLINE fromRaggedArray #-}  -- | Same as `fromRaggedArray`, but will throw an error if its shape is not@@ -317,4 +334,3 @@     Left RowTooLongError  -> error "Too many elements in a row"     Right resArr          -> resArr {-# INLINE fromRaggedArray' #-}-
src/Data/Massiv/Array/Manifest/Primitive.hs view
@@ -1,9 +1,11 @@ {-# LANGUAGE BangPatterns          #-} {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MagicHash             #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables   #-} {-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE UnboxedTuples         #-} {-# LANGUAGE UndecidableInstances  #-} -- | -- Module      : Data.Massiv.Array.Manifest.Primitive@@ -22,7 +24,7 @@  import           Control.DeepSeq                     (NFData (..), deepseq) import           Control.Monad.ST                    (runST)-import           Data.Massiv.Array.Delayed.Internal  (eq)+import           Data.Massiv.Array.Delayed.Internal  (eq, ord) import           Data.Massiv.Array.Manifest.Internal import           Data.Massiv.Array.Manifest.List     as A import           Data.Massiv.Array.Mutable@@ -33,8 +35,12 @@ import           Data.Primitive                      (sizeOf) import           Data.Primitive.ByteArray import           Data.Primitive.Types                (Prim)+import           Data.Primitive.Types import qualified Data.Vector.Primitive               as VP+import           GHC.Base                            (unsafeCoerce#) import           GHC.Exts                            as GHC (IsList (..))+import           GHC.Int                             (Int (..))+import           GHC.Prim import           Prelude                             hiding (mapM)  -- | Representation for `Prim`itive elements@@ -55,6 +61,9 @@   (==) = eq (==)   {-# INLINE (==) #-} +instance (Prim e, Ord e, Index ix) => Ord (Array P ix e) where+  compare = ord compare+  {-# INLINE compare #-}  instance (Prim e, Index ix) => Construct P ix e where   getComp = pComp@@ -161,7 +170,34 @@   unsafeLinearWrite (MPArray _ v) = writeByteArray v   {-# INLINE unsafeLinearWrite #-} +  unsafeNewA sz (State s#) =+    let kb# = totalSize# sz (undefined :: e)+        (# s'#, mba# #) = newByteArray# kb# s# in+      pure (State s'#, MPArray sz (MutableByteArray mba#))+  {-# INLINE unsafeNewA #-} +  unsafeThawA (PArray _ sz (ByteArray ba#)) s =+    pure (s, MPArray sz (MutableByteArray (unsafeCoerce# ba#)))+  {-# INLINE unsafeThawA #-}++  unsafeFreezeA comp (MPArray sz (MutableByteArray mba#)) (State s#) =+    let (# s'#, ba# #) = unsafeFreezeByteArray# mba# s# in+      pure (State s'#, PArray comp sz (ByteArray ba#))+  {-# INLINE unsafeFreezeA #-}++  unsafeLinearWriteA (MPArray _ (MutableByteArray mba#)) (I# i#) val (State s#) =+    pure (State (writeByteArray# mba# i# val s#))+  {-# INLINE unsafeLinearWriteA #-}++++totalSize# :: (Index ix, Prim e) => ix -> e -> Int#+totalSize# sz dummy = k# *# sizeOf# dummy+  where+    !(I# k#) = totalElem sz+{-# INLINE totalSize# #-}++ instance ( VP.Prim e          , IsList (Array L ix e)          , Nested LN ix e@@ -186,5 +222,4 @@            copyByteArray marr 0 arr (start * elSize) (len * elSize)            unsafeFreezeByteArray marr {-# INLINE vectorToByteArray #-}-
src/Data/Massiv/Array/Manifest/Storable.hs view
@@ -20,7 +20,7 @@   ) where  import           Control.DeepSeq                     (NFData (..), deepseq)-import           Data.Massiv.Array.Delayed.Internal  (eq)+import           Data.Massiv.Array.Delayed.Internal  (eq, ord) import           Data.Massiv.Array.Manifest.Internal import           Data.Massiv.Array.Manifest.List     as A import           Data.Massiv.Array.Mutable@@ -49,6 +49,10 @@ instance (VS.Storable e, Eq e, Index ix) => Eq (Array S ix e) where   (==) = eq (==)   {-# INLINE (==) #-}++instance (VS.Storable e, Ord e, Index ix) => Ord (Array S ix e) where+  compare = ord compare+  {-# INLINE compare #-}  instance (VS.Storable e, Index ix) => Construct S ix e where   getComp = sComp
src/Data/Massiv/Array/Manifest/Unboxed.hs view
@@ -20,7 +20,7 @@   ) where  import           Control.DeepSeq                     (NFData (..), deepseq)-import           Data.Massiv.Array.Delayed.Internal  (eq)+import           Data.Massiv.Array.Delayed.Internal  (eq, ord) import           Data.Massiv.Array.Manifest.Internal (M, toManifest) import           Data.Massiv.Array.Manifest.List     as A import           Data.Massiv.Array.Mutable@@ -63,6 +63,10 @@ instance (VU.Unbox e, Eq e, Index ix) => Eq (Array U ix e) where   (==) = eq (==)   {-# INLINE (==) #-}++instance (VU.Unbox e, Ord e, Index ix) => Ord (Array U ix e) where+  compare = ord compare+  {-# INLINE compare #-}   instance (VU.Unbox e, Index ix) => Source U ix e where
src/Data/Massiv/Array/Mutable.hs view
@@ -1,8 +1,11 @@+{-# LANGUAGE BangPatterns          #-} {-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MagicHash             #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables   #-} {-# LANGUAGE TypeFamilies          #-} {-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE UnboxedTuples         #-} -- | -- Module      : Data.Massiv.Array.Mutable -- Copyright   : (c) Alexey Kuleshevich 2018@@ -26,15 +29,27 @@   , modify'   , swap   , swap'+  -- * Generate (experimental)++  -- $generate+  , generateM+  , generateLinearM+  , mapM+  , imapM+  , forM+  , iforM+  , sequenceM   ) where -import           Prelude                  hiding (read)+import           Prelude                             hiding (mapM, read) -import           Control.Monad            (unless)-import           Control.Monad.Primitive  (PrimMonad (..))+import           Control.Monad                       (unless)+import           Control.Monad.Primitive             (PrimMonad (..)) import           Data.Massiv.Array.Manifest.Internal import           Data.Massiv.Array.Unsafe import           Data.Massiv.Core.Common+import           GHC.Int                             (Int (..))+import           GHC.Prim  -- errorSizeMismatch fName sz1 sz2 = --   error $ fName ++ ": Size mismatch: " ++ show sz1 ++ " /= " ++ show sz2@@ -156,3 +171,133 @@       else ix1 {-# INLINE swap' #-} ++unsafeLinearFillM :: (Mutable r ix e, Monad m) =>+                     MArray RealWorld r ix e -> (Int -> m e) -> WorldState -> m WorldState+unsafeLinearFillM ma f (State s_#) = go 0# s_#+  where+    !(I# k#) = totalElem (msize ma)+    go i# s# =+      case i# <# k# of+        0# -> return (State s#)+        _ -> do+          let i = I# i#+          res <- f i+          State s'# <- unsafeLinearWriteA ma i res (State s#)+          go (i# +# 1#) s'#+{-# INLINE unsafeLinearFillM #-}+++-- | /O(n)/ - Same as `generateM` but using a flat index.+--+-- @since 0.1.1+generateLinearM :: (Monad m, Mutable r ix e) => Comp -> ix -> (Int -> m e) -> m (Array r ix e)+generateLinearM comp sz f = do+  (s, mba) <- unsafeNewA (liftIndex (max 0) sz) (State (noDuplicate# realWorld#))+  s' <- unsafeLinearFillM mba f s+  (_, ba) <- unsafeFreezeA comp mba s'+  return ba+{-# INLINE generateLinearM #-}++-- | /O(n)/ - Generate an array monadically using it's mutable interface. Computation will be done+  -- sequentially, regardless of `Comp` argument.+--+-- @since 0.1.1+generateM :: (Monad m, Mutable r ix e) => Comp -> ix -> (ix -> m e) -> m (Array r ix e)+generateM comp sz f = generateLinearM comp sz (f . fromLinearIndex sz)+{-# INLINE generateM #-}+++-- | /O(n)/ - Map an index aware monadic action over an Array. This operation will force computation+-- sequentially and will result in a manifest Array.+--+-- @since 0.1.1+imapM+  :: (Monad m, Source r ix e, Mutable r' ix e') =>+     r' -> (ix -> e -> m e') -> Array r ix e -> m (Array r' ix e')+imapM _ f arr =+  generateLinearM (getComp arr) sz (\ !i -> f (fromLinearIndex sz i) (unsafeLinearIndex arr i))+  where+    !sz = size arr+{-# INLINE imapM #-}++-- | /O(n)/ - Map a monadic action over an Array. This operation will force computation sequentially+-- and will result in a manifest Array.+--+-- @since 0.1.1+--+-- ====__Examples__+--+-- >>> mapM P (\i -> Just (i*i)) $ range Seq 0 5+-- Just (Array P Seq (5)+--   [ 0,1,4,9,16 ])+--+mapM+  :: (Monad m, Source r ix e, Mutable r' ix e') =>+     r' -> (e -> m e') -> Array r ix e -> m (Array r' ix e')+mapM r f = imapM r (const f)+{-# INLINE mapM #-}+++-- | /O(n)/ - Same as `mapM`, but with its arguments flipped.+--+-- @since 0.1.1+forM ::+     (Monad m, Source r ix e, Mutable r' ix e')+  => r'+  -> Array r ix e+  -> (e -> m e')+  -> m (Array r' ix e')+forM r = flip (mapM r)+{-# INLINE forM #-}+++-- | /O(n)/ - Same as `imapM`, but with its arguments flipped.+--+-- @since 0.1.1+iforM :: (Monad m, Source r ix e, Mutable r' ix e') =>+         r' -> Array r ix e -> (ix -> e -> m e') -> m (Array r' ix e')+iforM r = flip (imapM r)+{-# INLINE iforM #-}+++-- | /O(n)/ - Sequence monadic actions in a source Array. This operation will force the computation+-- sequentially and will result in a manifest Array.+--+-- @since 0.1.1+sequenceM+  :: (Monad m, Source r ix (m e), Mutable r' ix e) =>+     r' -> Array r ix (m e) -> m (Array r' ix e)+sequenceM r = mapM r id+{-# INLINE sequenceM #-}+++{- $generate++Functions in this sections can monadically generate manifest arrays using their associated mutable+interface. Due to the sequential nature of monads generation is done also sequentially regardless of+supplied computation strategy. All of functions here are very much experimental, so please+<https://github.com/lehins/massiv/issues/new report an issue> if you see something not working+properly.++Here is a very imperative like for loop that creates an array while performing a side effect for+each newly created element:++@+printSquare :: Int -> IO (Array P Ix1 Int)+printSquare n = forM P (range Seq 0 n) $ \i -> do+  let e = i*i+  putStrLn $ "Element at index: " ++ show i ++ " = " ++ show e ++ ";"+  return e+@++>>> printSquare 5+Element at index: 0 = 0;+Element at index: 1 = 1;+Element at index: 2 = 4;+Element at index: 3 = 9;+Element at index: 4 = 16;+(Array P Seq (5)+  [ 0,1,4,9,16 ])++-}
src/Data/Massiv/Array/Ops/Map.hs view
@@ -14,8 +14,8 @@   , imap   -- ** Monadic   , mapM_-  , imapM_   , forM_+  , imapM_   , iforM_   , mapP_   , imapP_@@ -30,13 +30,14 @@   , izipWith3   ) where -import           Control.Monad              (void, when)++import           Control.Monad                       (void, when) import           Data.Massiv.Array.Delayed.Internal import           Data.Massiv.Core.Common import           Data.Massiv.Core.Scheduler-import           Prelude                    hiding (map, mapM_, unzip, unzip3,-                                             zip, zip3, zipWith, zipWith3)-+import           Prelude                             hiding (map, mapM, mapM_,+                                                      unzip, unzip3, zip, zip3,+                                                      zipWith, zipWith3)  -- | Map a function over an array map :: Source r ix e' => (e' -> e) -> Array r ix e' -> Array D ix e@@ -148,22 +149,6 @@ {-# INLINE forM_ #-}  --- | Map a monadic index aware function over an array sequentially, while discarding the result.------ ==== __Examples__------ >>> imapM_ (curry print) $ range 10 15--- (0,10)--- (1,11)--- (2,12)--- (3,13)--- (4,14)----imapM_ :: (Source r ix a, Monad m) => (ix -> a -> m b) -> Array r ix a -> m ()-imapM_ f !arr =-  iterM_ zeroIndex (size arr) 1 (<) $ \ !ix -> f ix (unsafeIndex arr ix)-{-# INLINE imapM_ #-}- -- | Just like `imapM_`, except with flipped arguments. iforM_ :: (Source r ix a, Monad m) => Array r ix a -> (ix -> a -> m b) -> m () iforM_ = flip imapM_@@ -197,24 +182,3 @@         void $ f ix (unsafeLinearIndex arr i) {-# INLINE imapP_ #-} ----- -- | Map an IO action, that is index aware, over an array in parallel, while--- -- discarding the result.--- imapP_ :: (NFData b, Source r ix a) => (ix -> a -> IO b) -> Array r ix a -> IO ()--- imapP_ f !arr = do---   let !sz = size arr---   splitWork_ sz $ \ !scheduler !chunkLength !totalLength !slackStart -> do---     loopM_ 0 (< slackStart) (+ chunkLength) $ \ !start ->---       submitRequest scheduler $---       JobRequest 0 $---       iterLinearM_ sz start (start + chunkLength) 1 (<) $ \ !i ix -> do---         res <- f ix (unsafeLinearIndex arr i)---         res `deepseq` return ()---     when (slackStart < totalLength) $---       submitRequest scheduler $---       JobRequest 0 $---       iterLinearM_ sz slackStart totalLength 1 (<) $ \ !i ix -> do---         res <- f ix (unsafeLinearIndex arr i)---         res `deepseq` return ()--- {-# INLINE imapP_ #-}
src/Data/Massiv/Core.hs view
@@ -62,3 +62,4 @@ isEmpty :: Size r ix e => Array r ix e -> Bool isEmpty !arr = 0 == elemsCount arr {-# INLINE isEmpty #-}+
src/Data/Massiv/Core/Common.hs view
@@ -1,8 +1,11 @@ {-# LANGUAGE BangPatterns          #-} {-# LANGUAGE DefaultSignatures     #-} {-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MagicHash             #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-} {-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE UnboxedTuples         #-} {-# LANGUAGE UndecidableInstances  #-} -- | -- Module      : Data.Massiv.Core.Common@@ -24,6 +27,8 @@   , InnerSlice(..)   , Manifest(..)   , Mutable(..)+  , State(..)+  , WorldState   , Ragged(..)   , Nested(..)   , NestedStruct@@ -39,13 +44,16 @@   , borderIndex   , evaluateAt   , module Data.Massiv.Core.Index+  -- * Common Operations+  , imapM_   , module Data.Massiv.Core.Computation   ) where -import           Control.Monad.Primitive      (PrimMonad (..))+import           Control.Monad.Primitive import           Data.Massiv.Core.Computation import           Data.Massiv.Core.Index import           Data.Typeable+import           GHC.Prim  -- | The array family. Representations @r@ describes 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@@ -147,6 +155,11 @@   unsafeLinearIndexM :: Array r ix e -> Int -> e  +data State s = State (State# s)++type WorldState = State RealWorld++ class Manifest r ix e => Mutable r ix e where   data MArray s r ix e :: * @@ -175,7 +188,37 @@   unsafeLinearWrite :: PrimMonad m =>                        MArray (PrimState m) r ix e -> Int -> e -> m () +  -- | Create new mutable array, leaving it's elements uninitialized. Size isn't validated+  -- either.+  unsafeNewA :: Applicative f => ix -> WorldState -> f (WorldState, MArray RealWorld r ix e)+  unsafeNewA sz (State s#) =+    case internal (unsafeNew sz :: IO (MArray RealWorld r ix e)) s# of+      (# s'#, ma #) -> pure (State s'#, ma)+  {-# INLINE unsafeNewA #-} +  unsafeThawA :: Applicative m =>+                 Array r ix e -> WorldState -> m (WorldState, MArray RealWorld r ix e)+  unsafeThawA arr (State s#) =+    case internal (unsafeThaw arr :: IO (MArray RealWorld r ix e)) s# of+      (# s'#, ma #) -> pure (State s'#, ma)+  {-# INLINE unsafeThawA #-}++  unsafeFreezeA :: Applicative m =>+                   Comp -> MArray RealWorld r ix e -> WorldState -> m (WorldState, Array r ix e)+  unsafeFreezeA comp marr (State s#) =+    case internal (unsafeFreeze comp marr :: IO (Array r ix e)) s# of+      (# s'#, a #) -> pure (State s'#, a)+  {-# INLINE unsafeFreezeA #-}++  unsafeLinearWriteA :: Applicative m =>+                        MArray RealWorld r ix e -> Int -> e -> WorldState -> m WorldState+  unsafeLinearWriteA marr i val (State s#) =+    case internal (unsafeLinearWrite marr i val :: IO ()) s# of+      (# s'#, _ #) -> pure (State s'#)+  {-# INLINE unsafeLinearWriteA #-}+++ class Nested r ix e where   fromNested :: NestedStruct r ix e -> Array r ix e @@ -310,3 +353,21 @@ -- errorImpossible loc = --   error $ "Please report this error. Impossible happend at: " ++ loc -- {-# NOINLINE errorImpossible #-}++++-- | Map a monadic index aware function over an array sequentially, while discarding the result.+--+-- ==== __Examples__+--+-- >>> imapM_ (curry print) $ range 10 15+-- (0,10)+-- (1,11)+-- (2,12)+-- (3,13)+-- (4,14)+--+imapM_ :: (Source r ix a, Monad m) => (ix -> a -> m b) -> Array r ix a -> m ()+imapM_ f !arr =+  iterM_ zeroIndex (size arr) 1 (<) $ \ !ix -> f ix (unsafeIndex arr ix)+{-# INLINE imapM_ #-}
src/Data/Massiv/Core/Index/Class.hs view
@@ -21,20 +21,30 @@ import           Data.Massiv.Core.Iterator import           GHC.TypeLits +-- | A way to select Array dimension. newtype Dim = Dim Int deriving (Show, Eq, Ord, Num, Real, Integral, Enum) +-- | Zero-dimension, i.e. a scalar. Can't really be used directly as there are no instances of+-- `Index` for it, and is included for completeness. data Ix0 = Ix0 deriving (Eq, Ord, Show) +-- | 1-dimensional index. Synonym for `Int` and `Data.Massiv.Core.Index.Ix.Ix1`. type Ix1T = Int +-- | 2-dimensional index as tuple of `Int`s. type Ix2T = (Int, Int) +-- | 3-dimensional index as 3-tuple of `Int`s. type Ix3T = (Int, Int, Int) +-- | 4-dimensional index as 4-tuple of `Int`s. type Ix4T = (Int, Int, Int, Int) +-- | 5-dimensional index as 5-tuple of `Int`s. type Ix5T = (Int, Int, Int, Int, Int) +-- | This type family will always point to a type for a dimension that is one lower than the type+-- argument. type family Lower ix :: *  type instance Lower Ix1T = Ix0@@ -43,34 +53,46 @@ type instance Lower Ix4T = Ix3T type instance Lower Ix5T = Ix4T -+-- | This is bread and butter of multi-dimensional array indexing. It is unlikely that any of the+-- functions in this class will be useful to a regular user, unless general algorithms are being+-- implemented that do span multiple dimensions. class (Eq ix, Ord ix, Show ix, NFData ix) => Index ix where   type Rank ix :: Nat +  -- | Rank of an array that has this index type, i.e. what is the dimensionality.   rank :: ix -> Dim    -- | Total number of elements in an array of this size.   totalElem :: ix -> Int +  -- | Prepend a dimension to the index   consDim :: Int -> Lower ix -> ix +  -- | Take a dimension from the index from the outside   unconsDim :: ix -> (Int, Lower ix) +  -- | Apppend a dimension to the index   snocDim :: Lower ix -> Int -> ix +  -- | Take a dimension from the index from the inside   unsnocDim :: ix -> (Lower ix, Int) +  -- | Remove a dimension from the index   dropDim :: ix -> Dim -> Maybe (Lower ix) +  -- | Extract the value index has at specified dimension.   getIndex :: ix -> Dim -> Maybe Int +  -- | Set the value for an index at specified dimension.   setIndex :: ix -> Dim -> Int -> Maybe ix +  -- | Lift an `Int` to any index by replicating the value as many times as there are dimensions.   pureIndex :: Int -> ix    -- | Zip together two indices with a function   liftIndex2 :: (Int -> Int -> Int) -> ix -> ix -> ix +  -- | Index with all zeros   zeroIndex :: ix   zeroIndex = pureIndex 0   {-# INLINE [1] zeroIndex #-}@@ -91,17 +113,18 @@       !(i0, ixL) = unconsDim ix   {-# INLINE [1] isSafeIndex #-} -  -- | Produce linear index from size and index+  -- | Convert linear index from size and index   toLinearIndex :: ix -- ^ Size                 -> ix -- ^ Index                 -> Int-   default toLinearIndex :: Index (Lower ix) => ix -> ix -> Int   toLinearIndex !sz !ix = toLinearIndex szL ixL * n + i     where !(szL, n) = unsnocDim sz           !(ixL, i) = unsnocDim ix   {-# INLINE [1] toLinearIndex #-} +  -- | Convert linear index from size and index with an accumulator. Currently is useless and will+  -- likley be removed in future versions.   toLinearIndexAcc :: Int -> ix -> ix -> Int   default toLinearIndexAcc :: Index (Lower ix) => Int -> ix -> ix -> Int   toLinearIndexAcc !acc !sz !ix = toLinearIndexAcc (acc * n + i) szL ixL@@ -109,13 +132,15 @@           !(i, ixL) = unconsDim ix   {-# INLINE [1] toLinearIndexAcc #-} -  -- | Produce N Dim index from size and linear index+  -- | Compute an index from size and linear index   fromLinearIndex :: ix -> Int -> ix   default fromLinearIndex :: Index (Lower ix) => ix -> Int -> ix   fromLinearIndex sz k = consDim q ixL     where !(q, ixL) = fromLinearIndexAcc (snd (unconsDim sz)) k   {-# INLINE [1] fromLinearIndex #-} +  -- | Compute an index from size and linear index using an accumulator, thus trying to optimize for+  -- tail recursion while getting the index computed.   fromLinearIndexAcc :: ix -> Int -> (Int, ix)   default fromLinearIndexAcc :: Index (Lower ix) => ix -> Int -> (Int, ix)   fromLinearIndexAcc ix' !k = (q, consDim r ixL)@@ -124,7 +149,13 @@           !(q, r) = quotRem kL m   {-# INLINE [1] fromLinearIndexAcc #-} -  repairIndex :: ix -> ix -> (Int -> Int -> Int) -> (Int -> Int -> Int) -> ix+  -- | A way to make sure index is withing the bounds for the supplied size. Takes two functions+  -- that will be invoked whenever index (2nd arg) is outsize the supplied size (1st arg)+  repairIndex :: ix -- ^ Size+              -> ix -- ^ Index+              -> (Int -> Int -> Int) -- ^ Repair when below zero+              -> (Int -> Int -> Int) -- ^ Repair when higher than size+              -> ix   default repairIndex :: Index (Lower ix)     => ix -> ix -> (Int -> Int -> Int) -> (Int -> Int -> Int) -> ix   repairIndex !sz !ix rBelow rOver =@@ -133,16 +164,18 @@           !(i, ixL) = unconsDim ix   {-# INLINE [1] repairIndex #-} +  -- | Iterator for the index. Same as `iterM`, but pure.   iter :: ix -> ix -> Int -> (Int -> Int -> Bool) -> a -> (ix -> a -> a) -> a   iter sIx eIx inc cond acc f =     runIdentity $ iterM sIx eIx inc cond acc (\ix -> return . f ix)   {-# INLINE iter #-} +  -- | This function is what makes it possible to iterate over an array of any dimension.   iterM :: Monad m =>            ix -- ^ Start index         -> ix -- ^ End index         -> Int -- ^ Increment-        -> (Int -> Int -> Bool) -- ^ Continue iteration while predicate is True (eg. until end of row)+        -> (Int -> Int -> Bool) -- ^ Continue iterating while predicate is True (eg. until end of row)         -> a -- ^ Initial value for an accumulator         -> (ix -> a -> m a) -- ^ Accumulator function         -> m a@@ -157,6 +190,7 @@       !(k1, eIxL) = unconsDim eIx   {-# INLINE iterM #-} +  -- | Same as `iterM`, but don't bother with accumulator and return value.   iterM_ :: Monad m => ix -> ix -> Int -> (Int -> Int -> Bool) -> (ix -> m a) -> m ()   default iterM_ :: (Index (Lower ix), Monad m)     => ix -> ix -> Int -> (Int -> Int -> Bool) -> (ix -> m a) -> m ()@@ -372,7 +406,7 @@     (f i0 j0, f i1 j1, f i2 j2, f i3 j3, f i4 j4)   {-# INLINE [1] liftIndex2 #-} -+-- | Helper function for throwing out of bounds errors errorIx :: (Show ix, Show ix') => String -> ix -> ix' -> a errorIx fName sz ix =   error $
src/Data/Massiv/Core/Index/Ix.hs view
@@ -39,33 +39,51 @@  infixr 5 :>, :. +-- | Another type synonym for 1-dimensional index, i.e. `Int` and `Ix1T`. Provided here purely for+-- consistency. type Ix1 = Int +-- | This is a very handy pattern synonym to indicate that any arbitrary whole number is an `Int`,+-- i.e. a 1-dimensional index: @(Ix1 i) == (i :: Int)@ pattern Ix1 :: Int -> Ix1 pattern Ix1 i = i +-- | 2-dimensional index. This also a base index for higher dimensions. data Ix2 = (:.) {-# UNPACK #-} !Int {-# UNPACK #-} !Int++-- | 2-dimensional index constructor. Useful when @TypeOperators@ extension isn't enabled, or simply+-- infix notation is inconvenient. @(Ix2 i j) == (i :. j)@. pattern Ix2 :: Int -> Int -> Ix2 pattern Ix2 i j = i :. j +-- | 3-dimensional type synonym. Useful as a alternative to enabling @DataKinds@ and using type+-- level Nats. type Ix3 = IxN 3++-- | 3-dimensional index constructor. @(Ix3 i j k) == (i :> j :. k)@. pattern Ix3 :: Int -> Int -> Int -> Ix3 pattern Ix3 i j k = i :> j :. k +-- | 4-dimensional type synonym. type Ix4 = IxN 4+-- | 4-dimensional index constructor. @(Ix4 i j k l) == (i :> j :> k :. l)@. pattern Ix4 :: Int -> Int -> Int -> Int -> Ix4 pattern Ix4 i j k l = i :> j :> k :. l +-- | 5-dimensional type synonym. type Ix5 = IxN 5+-- | 5-dimensional index constructor.  @(Ix5 i j k l m) = (i :> j :> k :> l :. m)@. pattern Ix5 :: Int -> Int -> Int -> Int -> Int -> Ix5 pattern Ix5 i j k l m = i :> j :> k :> l :. m   #if __GLASGOW_HASKELL__ >= 800 +-- | n-dimensional index. Needs a base case, which is the `Ix2`. data IxN (n :: Nat) where   (:>) :: {-# UNPACK #-} !Int -> !(Ix (n - 1)) -> IxN n +-- | Define n-dimensional index by relating a general `IxN` with two few cases. type family Ix (n :: Nat) = r | r -> n where   Ix 0 = Ix0   Ix 1 = Ix1@@ -200,35 +218,42 @@ instance Ord (Ix (n - 1)) => Ord (IxN n) where   compare (i1 :> ix1) (i2 :> ix2) = compare i1 i2 <> compare ix1 ix2 -+-- | Convert a `Int` tuple to `Ix2` toIx2 :: Ix2T -> Ix2 toIx2 (i, j) = i :. j {-# INLINE toIx2 #-} +-- | Convert an `Ix2` to `Int` tuple fromIx2 :: Ix2 -> Ix2T fromIx2 (i :. j) = (i, j) {-# INLINE fromIx2 #-} +-- | Convert a `Int` 3-tuple to `Ix3` toIx3 :: Ix3T -> Ix3 toIx3 (i, j, k) = i :> j :. k {-# INLINE toIx3 #-} +-- | Convert an `Ix3` to `Int` 3-tuple fromIx3 :: Ix3 -> Ix3T fromIx3 (i :> j :. k) = (i, j, k) {-# INLINE fromIx3 #-} +-- | Convert a `Int` 4-tuple to `Ix4` toIx4 :: Ix4T -> Ix4 toIx4 (i, j, k, l) = i :> j :> k :. l {-# INLINE toIx4 #-} +-- | Convert an `Ix4` to `Int` 4-tuple fromIx4 :: Ix4 -> Ix4T fromIx4 (i :> j :> k :. l) = (i, j, k, l) {-# INLINE fromIx4 #-} +-- | Convert a `Int` 5-tuple to `Ix5` toIx5 :: Ix5T -> Ix5 toIx5 (i, j, k, l, m) = i :> j :> k :> l :. m {-# INLINE toIx5 #-} +-- | Convert an `Ix5` to `Int` 5-tuple fromIx5 :: Ix5 -> Ix5T fromIx5 (i :> j :> k :> l :. m) = (i, j, k, l, m) {-# INLINE fromIx5 #-}
src/Data/Massiv/Core/Iterator.hs view
@@ -11,34 +11,50 @@   ( loop   , loopM   , loopM_+  , loopDeepM   ) where   -- | Efficient loop with an accumulator loop :: Int -> (Int -> Bool) -> (Int -> Int) -> a -> (Int -> a -> a) -> a-loop !init' condition increment !initAcc f = go init' initAcc where-  go !step !acc =-    case condition step of-      False -> acc-      True  -> go (increment step) (f step acc)+loop !init' condition increment !initAcc f = go init' initAcc+  where+    go !step !acc =+      case condition step of+        False -> acc+        True -> go (increment step) (f step acc) {-# INLINE loop #-}   -- | Very efficient monadic loop with an accumulator loopM :: Monad m => Int -> (Int -> Bool) -> (Int -> Int) -> a -> (Int -> a -> m a) -> m a-loopM !init' condition increment !initAcc f = go init' initAcc where-  go !step !acc =-    case condition step of-      False -> return acc-      True  -> f step acc >>= go (increment step)+loopM !init' condition increment !initAcc f = go init' initAcc+  where+    go !step !acc =+      case condition step of+        False -> return acc+        True -> f step acc >>= go (increment step) {-# INLINE loopM #-}   -- | Efficient monadic loop. Result of each iteration is discarded. loopM_ :: Monad m => Int -> (Int -> Bool) -> (Int -> Int) -> (Int -> m a) -> m ()-loopM_ !init' condition increment f = go init' where-  go !step =-    case condition step of-      False -> return ()-      True  -> f step >> go (increment step)+loopM_ !init' condition increment f = go init'+  where+    go !step =+      case condition step of+        False -> return ()+        True -> f step >> go (increment step) {-# INLINE loopM_ #-}+++-- | Less efficient monadic loop with an accumulator that reverses the direction of action+-- application+loopDeepM :: Monad m => Int -> (Int -> Bool) -> (Int -> Int) -> a -> (Int -> a -> m a) -> m a+loopDeepM !init' condition increment !initAcc f = go init' initAcc+  where+    go !step !acc =+      case condition step of+        False -> return acc+        True -> go (increment step) acc >>= f step+{-# INLINE loopDeepM #-}
src/Data/Massiv/Core/List.hs view
@@ -26,7 +26,7 @@   ) where  import           Control.Exception-import           Control.Monad              (unless)+import           Control.Monad              (unless, when) import           Data.Coerce import           Data.Foldable              (foldr') import           Data.Functor.Identity@@ -125,8 +125,13 @@   {-# INLINE uncons #-}   flatten = id   {-# INLINE flatten #-}+  -- unsafeGenerateM !comp !k f = do+  --   xs <- loopM (k - 1) (>= 0) (subtract 1) [] $ \i acc -> do+  --     e <- f i+  --     return (e:acc)+  --   return $ LArray comp $ coerce xs   unsafeGenerateM !comp !k f = do-    xs <- loopM (k - 1) (>= 0) (subtract 1) [] $ \i acc -> do+    xs <- loopDeepM 0 (< k) (+ 1) [] $ \i acc -> do       e <- f i       return (e:acc)     return $ LArray comp $ coerce xs@@ -174,11 +179,17 @@             newX = LArray lComp x         in Just (newX, newArr)   {-# INLINE uncons #-}-  unsafeGenerateM !comp !sz f = do+  -- unsafeGenerateM Seq !sz f = do+  --   let !(k, szL) = unconsDim sz+  --   loopM (k - 1) (>= 0) (subtract 1) (empty Seq) $ \i acc -> do+  --     e <- unsafeGenerateM Seq szL (\ !ixL -> f (consDim i ixL))+  --     return (cons e acc)+  unsafeGenerateM Seq !sz f = do     let !(k, szL) = unconsDim sz-    loopM (k - 1) (>= 0) (subtract 1) (empty comp) $ \i acc -> do-      e <- unsafeGenerateM comp szL (\ !ixL -> f (consDim i ixL))+    loopDeepM 0 (< k) (+ 1) (empty Seq) $ \i acc -> do+      e <- unsafeGenerateM Seq szL (\ !ixL -> f (consDim i ixL))       return (cons e acc)+  unsafeGenerateM (ParOn wss) sz f = unsafeGenerateParM wss sz f   {-# INLINE unsafeGenerateM #-}   flatten arr = LArray {lComp = lComp arr, lData = coerce xs}     where@@ -206,6 +217,87 @@       (coerce xs)  +-- unsafeGenerateParM ::+--      (Elt LN ix e ~ Array LN (Lower ix) e, Index ix, Monad m, Ragged L (Lower ix) e)+--   => [Int]+--   -> ix+--   -> (ix -> m e)+--   -> m (Array L ix e)+-- unsafeGenerateParM wws !sz f = do+--   res <- sequence $ unsafePerformIO $ do+--     let !(k, szL) = unconsDim sz+--     resLs <- divideWork wws k $ \ !scheduler !chunkLength !totalLength !slackStart -> do+--         loopM_ 0 (< slackStart) (+ chunkLength) $ \ !start -> do+--           scheduleWork scheduler $ do+--             res <- loopM start (< (start + chunkLength)) (+ 1) [] $ \i acc -> do+--               return (fmap lData (unsafeGenerateM Seq szL (\ !ixL -> f (consDim i ixL))):acc)+--             return $! sequence res+--         when (slackStart < totalLength) $+--           scheduleWork scheduler $ do+--             res <- loopM (slackStart) (< totalLength) (+ 1) [] $ \i acc -> do+--               return (fmap lData (unsafeGenerateM Seq szL (\ !ixL -> f (consDim i ixL))):acc)+--             return $! sequence res+--     return resLs+--   return $ LArray (ParOn wws) $ List $ concat res+-- {-# INLINE unsafeGenerateParM #-}++unsafeGenerateParM ::+     (Elt LN ix e ~ Array LN (Lower ix) e, Index ix, Monad m, Ragged L (Lower ix) e)+  => [Int]+  -> ix+  -> (ix -> m e)+  -> m (Array L ix e)+unsafeGenerateParM wws !sz f = do+  res <- sequence $ unsafePerformIO $ do+    let !(k, szL) = unconsDim sz+    resLs <- divideWork wws k $ \ !scheduler !chunkLength !totalLength !slackStart -> do+        loopM_ 0 (< slackStart) (+ chunkLength) $ \ !start -> do+          scheduleWork scheduler $ do+            -- res <- loopM (start + chunkLength - 1) (>= start) (subtract 1) [] $ \i acc -> do+            --   return (fmap lData (unsafeGenerateM Seq szL (\ !ixL -> f (consDim i ixL))):acc)+            -- return $! sequence res+            res <- loopDeepM start (< (start + chunkLength)) (+ 1) [] $ \i acc -> do+              return (fmap lData (unsafeGenerateM Seq szL (\ !ixL -> f (consDim i ixL))):acc)+            return $! sequence res+        when (slackStart < totalLength) $+          scheduleWork scheduler $ do+            -- res <- loopM (totalLength - 1) (>= slackStart) (subtract 1) [] $ \i acc -> do+            --   return (fmap lData (unsafeGenerateM Seq szL (\ !ixL -> f (consDim i ixL))):acc)+            -- return $! sequence res+            res <- loopDeepM slackStart (< totalLength) (+ 1) [] $ \i acc -> do+              return (fmap lData (unsafeGenerateM Seq szL (\ !ixL -> f (consDim i ixL))):acc)+            return $! sequence res+    return resLs+  return $ LArray (ParOn wws) $ List $ concat res+{-# INLINE unsafeGenerateParM #-}++++-- unsafeGenerateParM ::+--      (Elt LN ix e ~ Array LN (Lower ix) e, Index ix, Monad m, Ragged L (Lower ix) e)+--   => [Int]+--   -> ix+--   -> (ix -> m e)+--   -> m (Array L ix e)+-- unsafeGenerateParM wws !sz f = do+--   res <- sequence $ unsafePerformIO $ do+--     let !(k, szL) = unconsDim sz+--     resLs <- divideWork wws k $ \ !scheduler !chunkLength !totalLength !slackStart -> do+--         when (slackStart < totalLength) $+--           scheduleWork scheduler $ do+--             res <- loopM (totalLength - 1) (>= slackStart) (subtract 1) [] $ \i acc -> do+--               return (fmap lData (unsafeGenerateM Seq szL (\ !ixL -> f (consDim i ixL))):acc)+--             return $! sequence res+--         loopM_ slackStart (> 0) (subtract chunkLength) $ \ !start -> do+--           let !end = start - chunkLength+--           scheduleWork scheduler $ do+--             res <- loopM (start - 1) (>= end) (subtract 1) [] $ \i acc -> do+--               return (fmap lData (unsafeGenerateM Seq szL (\ !ixL -> f (consDim i ixL))):acc)+--             return $! sequence res+--     return resLs+--   return $ LArray (ParOn wws) $ List $ concat res+-- {-# INLINE unsafeGenerateParM #-}+ instance {-# OVERLAPPING #-} Construct L Ix1 e where   getComp = lComp   {-# INLINE getComp #-}@@ -231,7 +323,7 @@   unsafeMakeArray comp sz f = unsafeGenerateN comp sz f   {-# INLINE unsafeMakeArray #-} -+ -- TODO: benchmark against using unsafeGenerateM directly unsafeGenerateN ::   ( Index ix   , Ragged r ix e@@ -258,18 +350,6 @@   unsafeMakeArray (getComp arr) (size arr) (unsafeIndex arr) {-# INLINE toListArray #-} ------ -- | Version of foldr that supports foldr/build list fusion implemented by GHC.--- foldrFB :: (e -> b -> b) -> b -> Int -> (Int -> e) -> b--- --foldrFB c n k f = loop (k - 1) (>= 0) (subtract 1) n $ \i acc -> f i `c` acc--- foldrFB c n k f = go 0---   where---     go !i---       | i == k = n---       | otherwise = let !v = f i in v `c` go (i + 1)--- {-# INLINE [0] foldrFB #-}   instance {-# OVERLAPPING #-} (Ragged L ix e, Show e) => Show (Array L ix e) where
src/Data/Massiv/Core/Scheduler.hs view
@@ -79,9 +79,9 @@ uninitialized = error "Data.Array.Massiv.Scheduler: uncomputed job result"  --- | Execute some action that needs a resource. Perform different cleanup--- actions depending if thataction resulted in an error or was successful. Sort--- of like `bracket` and `bracketOnError` with info about exception combined.+-- | Execute some action that needs a resource. Perform different cleanup actions depending if+-- thataction resulted in an error or was successful. Sort of like `bracket` and `bracketOnError`+-- with info about exception combined. bracketWithException :: forall a b c d .   IO a -- ^ Acquire resource   -> (a -> IO b) -- ^ Run after successfull execution@@ -99,18 +99,16 @@       _ <- uninterruptibleMask_ $ afterSuccess x       return y --- | Run arbitrary computations in parallel. A pool of workers is initialized,--- unless Worker Stations list is empty and a global worker pool is currently--- available. All of those workers will be stealing work that you can schedule--- using `scheduleWork`. The order in which work is scheduled will be the same--- as the order of the resuts of those computations, stored withing the--- resulting array. Size of the array, which is also the first element in the--- returned tuple, will match the number of times `scheduleWork` has been--- invoked. This function blocks until all of the submitted jobs has finished or--- one of them resulted in an exception, which will be re-thrown here.+-- | Run arbitrary computations in parallel. A pool of workers is initialized, unless Worker+-- Stations list is empty and a global worker pool is currently available. All of those workers will+-- be stealing work that you can schedule using `scheduleWork`. The order in which work is scheduled+-- will be the same as the order of the resuts of those computations, stored withing the resulting+-- array. Size of the array, which is also the first element in the returned tuple, will match the+-- number of times `scheduleWork` has been invoked. This function blocks until all of the submitted+-- jobs has finished or one of them resulted in an exception, which will be re-thrown here. ----- __Important__: In order to get work done truly in parallel, program needs to be--- compiled with @-threaded@ GHC flag and executed with @+RTS -N@.+-- __Important__: In order to get work done truly in parallel, program needs to be compiled with+-- @-threaded@ GHC flag and executed with @+RTS -N@. -- withScheduler :: [Int] -- ^ Worker Stations, i.e. capabilities. Empty list will                        -- result in utilization of all available capabilities.@@ -176,11 +174,10 @@ divideWork_ wss sz submit = divideWork wss sz submit >> return ()  --- | Linearly (row-major first) and equally divide work among available--- workers. Submit function will receive a `Scheduler`, length of each chunk,--- total number of elements, as well as where chunks end and slack begins. Slack--- work will get picked up by the first worker, that has finished working on his--- chunk. Returns list with results in the same order that work was submitted+-- | Linearly (row-major first) and equally divide work among available workers. Submit function+-- will receive a `Scheduler`, length of each chunk, total number of elements, as well as where+-- chunks end and slack begins. Slack work will get picked up by the first worker, that has finished+-- working on his chunk. Returns list with results in the same order that work was submitted divideWork :: Index ix            => [Int] -- ^ Worker Stations (capabilities)            -> ix -- ^ Size@@ -195,9 +192,8 @@           !slackStart = chunkLength * numWorkers scheduler       submit scheduler chunkLength totalLength slackStart --- | Wait till workers finished with all submitted jobs, but raise an exception--- if either of them has died. Raised exception is the same one that was the--- cause of worker's death.+-- | Wait till workers finished with all submitted jobs, but raise an exception if either of them+-- has died. Raised exception is the same one that was the cause of worker's death. waitTillDone :: Scheduler a -> IO () waitTillDone (Scheduler {..}) = readIORef jobsCountIORef >>= waitTill 0   where@@ -210,11 +206,10 @@             Nothing  -> waitTill (jobsDone + 1) jobsCount  --- | Worker can either be doing work, waiting for a job, or going into--- retirement. Temp workers are rarely in waiting state, unless there is simply--- not enough work for all workers in the pool. Unlike temp workers, global--- workers do spend quite a bit of time waiting for work and they are never--- retired, but ruthlessly killed.+-- | Worker can either be doing work, waiting for a job, or going into retirement. Temp workers are+-- rarely in waiting state, unless there is simply not enough work for all workers in the+-- pool. Unlike temp workers, global workers do spend quite a bit of time waiting for work and they+-- are never retired, but ruthlessly killed. runWorker :: MVar [Job] -> IO () runWorker jobsMVar = do   jobs <- takeMVar jobsMVar@@ -224,9 +219,8 @@     []             -> runWorker jobsMVar  --- | Used whenever a pool of new workers is needed. If list is empty all--- capabilities are utilized, otherwise each element in the list will be an--- argument to `forkOn`.+-- | Used whenever a pool of new workers is needed. If list is empty all capabilities are utilized,+-- otherwise each element in the list will be an argument to `forkOn`. hireWorkers :: [Int] -> IO Workers hireWorkers wss = do   wss' <-@@ -246,11 +240,10 @@           (unmask . putMVar workerJobDone . Just)   workerThreadIds `deepseq` return Workers {..} --- | Global workers are the most utilized ones, therefore they are rarily--- restarted, in particular, only in case when one of them dies of an--- exception. Weak reference is used so workers don't continue running after--- MVar has been cleaned up by the GC. Each global worker has his own station,--- i.e. global workers always span all available capabilities.+-- | Global workers are the most utilized ones, therefore they are rarily restarted, in particular,+-- only in case when one of them dies of an exception. Weak reference is used so workers don't+-- continue running after MVar has been cleaned up by the GC. Each global worker has his own+-- station, i.e. global workers always span all available capabilities. globalWorkersMVar :: MVar (Weak Workers) globalWorkersMVar = unsafePerformIO $ do   workersMVar <- newEmptyMVar@@ -260,8 +253,8 @@ {-# NOINLINE globalWorkersMVar #-}  --- | Hire workers under weak pointers. Finilizer will kill all the--- workers. These will be used as global workers+-- | Hire workers under weak pointers. Finalizer will kill all the workers. These will be used as+-- global workers hireWeakWorkers :: key -> IO (Weak Workers) hireWeakWorkers k = do   workers <- hireWorkers []
+ tests/Data/Massiv/Array/MutableSpec.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MonoLocalBinds        #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module Data.Massiv.Array.MutableSpec (spec) where++import           Data.Massiv.CoreArbitrary as A+import           Data.Proxy+import           Data.Functor.Identity+import           Test.Hspec+import           Test.QuickCheck+import           Test.QuickCheck.Function+++prop_MapMapM :: (Show (Array r ix Int), Eq (Array r ix Int), Mutable r ix Int) =>+                r -> Proxy ix -> Fun Int Int -> ArrTiny D ix Int -> Property+prop_MapMapM r _ f (ArrTiny arr) =+  computeAs r (A.map (apply f) arr) === runIdentity (A.mapM r (return . apply f) arr)++prop_iMapiMapM :: (Show (Array r ix Int), Eq (Array r ix Int), Mutable r ix Int) =>+                r -> Proxy ix -> Fun (ix, Int) Int -> ArrTiny D ix Int -> Property+prop_iMapiMapM r _ f (ArrTiny arr) =+  computeAs r (A.imap (curry (apply f)) arr) ===+  runIdentity (A.imapM r (\ix e -> return $ apply f (ix, e)) arr)+++generateSpec :: Spec+generateSpec = do+  describe "map == mapM" $ do+    describe "P" $ do+      it "Ix1" $ property $ prop_MapMapM P (Proxy :: Proxy Ix1)+      it "Ix2" $ property $ prop_MapMapM P (Proxy :: Proxy Ix2)+      it "Ix3" $ property $ prop_MapMapM P (Proxy :: Proxy Ix3)+    describe "U" $ do+      it "Ix1" $ property $ prop_MapMapM U (Proxy :: Proxy Ix1)+      it "Ix2" $ property $ prop_MapMapM U (Proxy :: Proxy Ix2)+      it "Ix3" $ property $ prop_MapMapM U (Proxy :: Proxy Ix3)+    describe "S" $ do+      it "Ix1" $ property $ prop_MapMapM S (Proxy :: Proxy Ix1)+      it "Ix2" $ property $ prop_MapMapM S (Proxy :: Proxy Ix2)+      it "Ix3" $ property $ prop_MapMapM S (Proxy :: Proxy Ix3)+    describe "B" $ do+      it "Ix1" $ property $ prop_MapMapM B (Proxy :: Proxy Ix1)+      it "Ix2" $ property $ prop_MapMapM B (Proxy :: Proxy Ix2)+      it "Ix3" $ property $ prop_MapMapM B (Proxy :: Proxy Ix3)+  describe "imap == imapM" $ do+    describe "P" $ do+      it "Ix1" $ property $ prop_iMapiMapM P (Proxy :: Proxy Ix1)+      it "Ix2T" $ property $ prop_iMapiMapM P (Proxy :: Proxy Ix2T)+      it "Ix3T" $ property $ prop_iMapiMapM P (Proxy :: Proxy Ix3T)+    describe "U" $ do+      it "Ix1" $ property $ prop_iMapiMapM U (Proxy :: Proxy Ix1)+      it "Ix2T" $ property $ prop_iMapiMapM U (Proxy :: Proxy Ix2T)+      it "Ix3T" $ property $ prop_iMapiMapM U (Proxy :: Proxy Ix3T)+    describe "S" $ do+      it "Ix1" $ property $ prop_iMapiMapM S (Proxy :: Proxy Ix1)+      it "Ix2T" $ property $ prop_iMapiMapM S (Proxy :: Proxy Ix2T)+      it "Ix3T" $ property $ prop_iMapiMapM S (Proxy :: Proxy Ix3T)+    describe "B" $ do+      it "Ix1" $ property $ prop_iMapiMapM B (Proxy :: Proxy Ix1)+      it "Ix2T" $ property $ prop_iMapiMapM B (Proxy :: Proxy Ix2T)+      it "Ix3T" $ property $ prop_iMapiMapM B (Proxy :: Proxy Ix3T)+++spec :: Spec+spec = describe "GenerateM" generateSpec
tests/Data/Massiv/Array/Ops/ConstructSpec.hs view
@@ -40,7 +40,10 @@   => Proxy ix   -> Arr U ix Int   -> Property-prop_toFromList _ (Arr arr) = arr === fromLists' (getComp arr) (toLists arr :: [ListItem ix Int])+prop_toFromList _ (Arr arr) = comp === comp' .&&. arr === arr'+  where comp = getComp arr+        arr' = fromLists' comp (toLists arr)+        comp' = getComp arr'   prop_excFromToListIx2 :: Comp -> [[Int]] -> Property
tests/Data/Massiv/CoreArbitrary.hs view
@@ -6,6 +6,7 @@ {-# LANGUAGE UndecidableInstances  #-} module Data.Massiv.CoreArbitrary   ( Arr(..)+  , ArrTiny(..)   , ArrIx(..)   , ArrP(..)   , ArrIxP(..)@@ -31,6 +32,8 @@  data Arr r ix e = Arr (Array r ix e) +data ArrTiny r ix e = ArrTiny (Array r ix e)+ data ArrS r ix e = ArrS (Array r ix e)  data ArrP r ix e = ArrP (Array r ix e)@@ -42,6 +45,7 @@ data ArrIxP r ix e = ArrIxP (Array r ix e) ix  deriving instance (Show (Array r ix e)) => Show (Arr r ix e)+deriving instance (Show (Array r ix e)) => Show (ArrTiny r ix e) deriving instance (Show (Array r ix e)) => Show (ArrS r ix e) deriving instance (Show (Array r ix e)) => Show (ArrP r ix e) deriving instance (Show (Array r ix e), Show ix) => Show (ArrIx r ix e)@@ -62,6 +66,15 @@     return $ makeArray comp sz func  +-- | Arbitrary small and possibly empty array. Computation strategy can be either `Seq` or `Par`.+instance (CoArbitrary ix, Arbitrary ix, Typeable e, Construct r ix e, Arbitrary e) =>+         Arbitrary (ArrTiny r ix e) where+  arbitrary = do+    SzZ sz <- arbitrary+    func <- arbitrary+    comp <- oneof [pure Seq, pure Par]+    return $ ArrTiny $ makeArray comp (liftIndex (`mod` 10) sz) func+ -- | Arbitrary non-empty array. Computation strategy can be either `Seq` or `Par`. instance (CoArbitrary ix, Arbitrary ix, Typeable e, Construct r ix e, Arbitrary e) =>          Arbitrary (Arr r ix e) where@@ -70,6 +83,7 @@     func <- arbitrary     comp <- oneof [pure Seq, pure Par]     return $ Arr $ makeArray comp sz func+  -- | Arbitrary non-empty array instance (CoArbitrary ix, Arbitrary ix, Typeable e, Construct r ix e, Arbitrary e) =>
tests/Spec.hs view
@@ -2,6 +2,7 @@  import           Data.Massiv.Array.DelayedSpec         as Delayed import           Data.Massiv.Array.Manifest.VectorSpec as Vector+import           Data.Massiv.Array.MutableSpec         as Mutable import           Data.Massiv.Array.Ops.ConstructSpec   as Construct import           Data.Massiv.Array.Ops.FoldSpec        as Fold import           Data.Massiv.Array.Ops.SliceSpec       as Slice@@ -27,6 +28,7 @@       Fold.spec       Slice.spec       Transform.spec-    Delayed.spec-    Stencil.spec-    Vector.spec+    describe "Delayed" $ Delayed.spec+    describe "Mutable" $ Mutable.spec+    describe "Stencil" $ Stencil.spec+    describe "Vector" $ Vector.spec