packages feed

yarr 1.2.3 → 1.3.1

raw patch · 20 files changed

+955/−724 lines, 20 files

Files

Data/Yarr.hs view
@@ -106,11 +106,7 @@            should be as as precise in types as possible.            Don't neglect writing signatures for functions. -        4. You shouldn't be very keen on bang patterns.-           They are more likey to harm than improve performance.-           However, in 95% of cases GHC ignores them.--        5. Compilation flags:+        4. Compilation flags:            @-Odph -rtsopts -threaded -fno-liberate-case -funbox-strict-fields@            @-fexpose-all-unfoldings -funfolding-keeness-factor1000@            @-fsimpl-tick-factor=500 -fllvm -optlo-O3@.@@ -130,7 +126,10 @@         * @d-@ prefix stands for \"default\". Typically function           with @d-@ prefix is carried version of the one without prefix. -        * @f-@ prefix means \"fused\". Used for functions from 'Data.Yarr.Base.Fusion' class.+        * @I-@, @i-@ prefixes for \"indexed\". Functions with this prefix accept+          array index before element itself.++        * @f-@ prefix means \"fused\". Used for functions from 'Data.Yarr.Fusion.Fusion' class.          * @-M@, as usual, is for monadic versions of functions.           However, if there isn't non-monadic version
Data/Yarr/Base.hs view
@@ -16,12 +16,12 @@     USource(..),     UVecSource(..), -    -- * Fusion-    DefaultFusion(..), Fusion(..),-     -- * Manifest and Target classes-    UTarget(..), Manifest(..), UVecTarget(..)+    UTarget(..), Manifest(..), UVecTarget(..), +    -- * Work index+    PreferredWorkIndex(..), WorkIndex(..),+ ) where  import Prelude as P@@ -144,170 +144,6 @@         UVecSource r slr l sh v e  --- | Generalized, non-injective version of 'DefaultFusion'. Used internally.------ Minimum complete defenition: 'fmapM', 'fzip2M', 'fzip3M' and 'fzipM'.------ The class doesn't have vector counterpart, it's role play top-level functions--- from "Data.Yarr.Repr.Separate" module.-class Fusion r fr l where-    fmap :: (USource r l sh a, USource fr l sh b)-         => (a -> b) -- ^ .-         -> UArray r l sh a -> UArray fr l sh b-    fmap f = fmapM (return . f)-    -    fmapM :: (USource r l sh a, USource fr l sh b)-          => (a -> IO b) -> UArray r l sh a -> UArray fr l sh b--    fzip2 :: (USource r l sh a, USource r l sh b, USource fr l sh c)-          => (a -> b -> c) -- ^ .-          -> UArray r l sh a-          -> UArray r l sh b-          -> UArray fr l sh c-    fzip2 f = fzip2M (\x y -> return (f x y))--    fzip2M :: (USource r l sh a, USource r l sh b, USource fr l sh c)-           => (a -> b -> IO c) -- ^ .-           -> UArray r l sh a-           -> UArray r l sh b-           -> UArray fr l sh c--    fzip3 :: (USource r l sh a, USource r l sh b, USource r l sh c,-              USource fr l sh d)-          => (a -> b -> c -> d) -- ^ .-          -> UArray r l sh a-          -> UArray r l sh b-          -> UArray r l sh c-          -> UArray fr l sh d-    fzip3 f = fzip3M (\x y z -> return (f x y z))--    fzip3M :: (USource r l sh a, USource r l sh b, USource r l sh c,-               USource fr l sh d)-           => (a -> b -> c -> IO d) -- ^ .-           -> UArray r l sh a-           -> UArray r l sh b-           -> UArray r l sh c-           -> UArray fr l sh d--    fzip :: (USource r l sh a, USource fr l sh b, Arity n, n ~ S n0)-         => Fun n a b -- ^ .-         -> VecList n (UArray r l sh a) -> UArray fr l sh b-    fzip fun arrs = let funM = P.fmap return fun in fzipM funM arrs--    fzipM :: (USource r l sh a, USource fr l sh b, Arity n, n ~ S n0)-          => Fun n a (IO b) -- ^ .-          -> VecList n (UArray r l sh a) -> UArray fr l sh b--    {-# INLINE fmap #-}-    {-# INLINE fzip2 #-}-    {-# INLINE fzip3 #-}-    {-# INLINE fzip #-}----- | This class abstracts pair of array types, which could be (preferably should be)--- mapped /(fused)/ one to another. Injective version of 'Fusion' class.--- --- Parameters:------  * @r@ - source array representation. It determines result representation.------  * @fr@ (fused repr) - result (fused) array representation. Result array---    isn't indeed presented in memory, finally it should be---    'Data.Yarr.Eval.compute'd or 'Data.Yarr.Eval.Load'ed to 'Manifest'---    representation.------  * @l@ - load type, common for source and fused arrays------ All functions are already defined, using non-injective versions from 'Fusion' class.------ The class doesn't have vector counterpart, it's role play top-level functions--- from "Data.Yarr.Repr.Separate" module.-class Fusion r fr l => DefaultFusion r fr l | r -> fr where-    -- | /O(1)/ Pure element mapping.-    ---    -- Main basic \"map\" in Yarr.-    dmap :: (USource r l sh a, USource fr l sh b)-         => (a -> b)         -- ^ Element mapper function-         -> UArray r l sh a  -- ^ Source array-         -> UArray fr l sh b -- ^ Result array-    dmap = Data.Yarr.Base.fmap-    -    -- | /O(1)/ Monadic element mapping.-    dmapM :: (USource r l sh a, USource fr l sh b)-          => (a -> IO b)      -- ^ Monadic element mapper function-          -> UArray r l sh a  -- ^ Source array-          -> UArray fr l sh b -- ^ Result array-    dmapM = fmapM--    -- | /O(1)/ Zipping 2 arrays of the same type indexes and shapes.-    -- -    -- Example:-    -- -    -- @-    -- let productArr = dzip2 (*) arr1 arr2-    -- @-    dzip2 :: (USource r l sh a, USource r l sh b, USource fr l sh c)-          => (a -> b -> c)     -- ^ Pure element zipper function-          -> UArray r l sh a   -- ^ 1st source array-          -> UArray r l sh b   -- ^ 2nd source array-          -> UArray fr l sh c  -- ^ Fused result array-    dzip2 = fzip2--    -- | /O(1)/ Monadic version of 'dzip2' function.-    dzip2M :: (USource r l sh a, USource r l sh b, USource fr l sh c)-           => (a -> b -> IO c) -- ^ Monadic element zipper function-           -> UArray r l sh a  -- ^ 1st source array-           -> UArray r l sh b  -- ^ 2nd source array-           -> UArray fr l sh c -- ^ Result array-    dzip2M = fzip2M--    -- | /O(1)/ Zipping 3 arrays of the same type indexes and shapes.-    dzip3 :: (USource r l sh a, USource r l sh b, USource r l sh c,-              USource fr l sh d)-          => (a -> b -> c -> d) -- ^ Pure element zipper function-          -> UArray r l sh a    -- ^ 1st source array-          -> UArray r l sh b    -- ^ 2nd source array-          -> UArray r l sh c    -- ^ 3rd source array-          -> UArray fr l sh d   -- ^ Result array-    dzip3 = fzip3--    -- | /O(1)/ Monadic version of 'dzip3' function.-    dzip3M :: (USource r l sh a, USource r l sh b, USource r l sh c,-               USource fr l sh d)-           => (a -> b -> c -> IO d) -- ^ Monadic element zipper function-           -> UArray r l sh a       -- ^ 1st source array-           -> UArray r l sh b       -- ^ 2nd source array-           -> UArray r l sh c       -- ^ 3rd source array-           -> UArray fr l sh d      -- ^ Fused result array-    dzip3M = fzip3M--    -- | /O(1)/ Generalized element zipping with pure function.-    -- Zipper function is wrapped in 'Fun' for injectivity.-    dzip :: (USource r l sh a, USource fr l sh b, Arity n, n ~ S n0)-         => Fun n a b                   -- ^ Wrapped function positionally-                                        -- accepts elements from source arrays-                                        -- and emits element for fused array-         -> VecList n (UArray r l sh a) -- ^ Source arrays-         -> UArray fr l sh b            -- ^ Result array-    dzip = fzip--    -- | /O(1)/ Monadic version of 'dzip' function.-    dzipM :: (USource r l sh a, USource fr l sh b, Arity n, n ~ S n0)-          => Fun n a (IO b)              -- ^ Wrapped monadic zipper-          -> VecList n (UArray r l sh a) -- ^ Source arrays-          -> UArray fr l sh b            -- ^ Result array-    dzipM = fzipM--    {-# INLINE dmap #-}-    {-# INLINE dmapM #-}-    {-# INLINE dzip2 #-}-    {-# INLINE dzip2M #-}-    {-# INLINE dzip3 #-}-    {-# INLINE dzip3M #-}-    {-# INLINE dzip #-}-    {-# INLINE dzipM #-}-- -- | Class for mutable arrays. -- -- Just like for 'USource', it's function are unsafe@@ -369,3 +205,44 @@ class (VecRegular tr tslr tl sh v e,        UTarget tr tl sh (v e), UTarget tslr tl sh e) =>         UVecTarget tr tslr tl sh v e+++-- | Internal implementation class. Generalizes @linear-@ and simple+-- indexing and writing function in 'USource' and 'UTarget' classes.+class (Shape sh, Shape i) => WorkIndex sh i where+    gindex :: USource r l sh a => UArray r l sh a -> i -> IO a+    gwrite :: UTarget tr tl sh a => UArray tr tl sh a -> i -> a -> IO ()+    gsize :: USource r l sh a => UArray r l sh a -> i++instance Shape sh => WorkIndex sh sh where+    gindex = index+    gwrite = write+    gsize = extent+    {-# INLINE gindex #-}+    {-# INLINE gwrite #-}+    {-# INLINE gsize #-}++#define WI_INT_INST(sh)           \+instance WorkIndex sh Int where { \+    gindex = linearIndex;         \+    gwrite = linearWrite;         \+    gsize = size . extent;        \+    {-# INLINE gindex #-};        \+    {-# INLINE gwrite #-};        \+    {-# INLINE gsize #-};         \+}++WI_INT_INST(Dim2)+WI_INT_INST(Dim3)++-- | Type level fixation of preferred work (load, fold, etc.)+-- index type of the array load type.+--+-- Parameters:+--+--  * @l@ - load type index+--+--  * @sh@ - shape of arrays+--+--  * @i@ - preferred work index, @Int@ or @sh@ itself+class WorkIndex sh i => PreferredWorkIndex l sh i | l sh -> i
Data/Yarr/Convolution/Eval.hs view
@@ -13,8 +13,6 @@ import Data.Yarr.Utils.Split  -instance Shape sh => PreferredWorkIndex CVL sh sh- instance (BlockShape sh, UTarget tr tl sh a) =>         Load CV CVL tr tl sh a where     type LoadIndex CVL tl sh = sh
Data/Yarr/Convolution/Repr.hs view
@@ -10,6 +10,7 @@  import Data.Yarr.Base import Data.Yarr.Shape+import Data.Yarr.Fusion import Data.Yarr.Repr.Delayed  import Data.Yarr.Utils.FixedVector as V@@ -44,6 +45,8 @@ -- @ffill@ function. data CVL +instance Shape sh => PreferredWorkIndex CVL sh sh+ instance Shape sh => Regular CV CVL sh a where      data UArray CV CVL sh a =@@ -93,11 +96,15 @@     {-# INLINE index #-}  -instance Fusion CV CV CVL where-    fmapM f (Convoluted sh tch iforce bget center cget) =-        Convoluted sh tch iforce (f <=< bget) center (f <=< cget)+instance Shape sh => IFusion CV CVL CV CVL sh where+    fimapM f (Convoluted sh tch iforce bget center cget) =+        Convoluted+            sh tch iforce+            (\sh -> bget sh >>= f sh)+            center+            (\sh -> cget sh >>= f sh) -    fzip2M f arr1 arr2 =+    fizip2M f arr1 arr2 =         let sh = intersect (vl_2 (extent arr1) (extent arr2))             ctr = intersectBlocks (vl_2 (center arr1) (center arr2))             tch = touchArray arr1 >> touchArray arr2@@ -107,17 +114,17 @@             bget sh = do                 v1 <- borderGet arr1 sh                 v2 <- borderGet arr2 sh-                f v1 v2+                f sh v1 v2              {-# INLINE cget #-}             cget sh = do                 v1 <- centerGet arr1 sh                 v2 <- centerGet arr2 sh-                f v1 v2+                f sh v1 v2          in Convoluted sh tch iforce bget ctr cget -    fzip3M f arr1 arr2 arr3 =+    fizip3M f arr1 arr2 arr3 =         let sh = intersect (vl_3 (extent arr1) (extent arr2) (extent arr3))             ctr = intersectBlocks (vl_3 (center arr1) (center arr2) (center arr3))             tch = touchArray arr1 >> touchArray arr2 >> touchArray arr3@@ -128,18 +135,18 @@                 v1 <- borderGet arr1 sh                 v2 <- borderGet arr2 sh                 v3 <- borderGet arr3 sh-                f v1 v2 v3+                f sh v1 v2 v3              {-# INLINE cget #-}             cget sh = do                 v1 <- centerGet arr1 sh                 v2 <- centerGet arr2 sh                 v3 <- centerGet arr3 sh-                f v1 v2 v3+                f sh v1 v2 v3          in Convoluted sh tch iforce bget ctr cget -    fzipM fun arrs =+    fizipM ifun arrs =         let sh = intersect $ V.map extent arrs              ctr = intersectBlocks $ V.map center arrs@@ -152,19 +159,20 @@             {-# INLINE bget #-}             bget sh = do                 v <- V.mapM ($ sh) bgets-                inspect v fun+                inspect v (ifun sh)              cgets = V.map centerGet arrs             {-# INLINE cget #-}             cget sh = do                 v <- V.mapM ($ sh) cgets-                inspect v fun+                inspect v (ifun sh)          in Convoluted sh tch iforce bget ctr cget -    {-# INLINE fmapM #-}-    {-# INLINE fzip2M #-}-    {-# INLINE fzip3M #-}-    {-# INLINE fzipM #-}+    {-# INLINE fimapM #-}+    {-# INLINE fizip2M #-}+    {-# INLINE fizip3M #-}+    {-# INLINE fizipM #-} -instance DefaultFusion CV CV CVL+instance Shape sh => DefaultIFusion CV CVL CV CVL sh+instance Shape sh => DefaultFusion CV CV CVL sh
Data/Yarr/Eval.hs view
@@ -17,11 +17,7 @@     L, SH,      -- * Utility-    entire,--    -- * Work index-    WorkIndex(..), PreferredWorkIndex(..),-+    entire ) where  import GHC.Conc@@ -52,37 +48,7 @@ {-# INLINE threads #-} threads = return --- | Internal implementation class.-class (Shape sh, Shape i) => WorkIndex sh i where-    gindex :: USource r l sh a => UArray r l sh a -> i -> IO a-    gwrite :: UTarget tr tl sh a => UArray tr tl sh a -> i -> a -> IO ()-    gsize :: USource r l sh a => UArray r l sh a -> i -instance Shape sh => WorkIndex sh sh where-    gindex = index-    gwrite = write-    gsize = extent-    {-# INLINE gindex #-}-    {-# INLINE gwrite #-}-    {-# INLINE gsize #-}--#define WI_INT_INST(sh)           \-instance WorkIndex sh Int where { \-    gindex = linearIndex;         \-    gwrite = linearWrite;         \-    gsize = size . extent;        \-    {-# INLINE gindex #-};        \-    {-# INLINE gwrite #-};        \-    {-# INLINE gsize #-};         \-}--WI_INT_INST(Dim2)-WI_INT_INST(Dim3)---- | Internal implementation class.-class WorkIndex sh i => PreferredWorkIndex l sh i | l sh -> i where-- -- | This class abstracts pair of array types, -- which could be loaded one to another. --@@ -463,4 +429,3 @@ SH_LOAD_INST(SH,L) SH_LOAD_INST(L,SH) SH_LOAD_INST(SH,SH)-
Data/Yarr/Flow.hs view
@@ -2,9 +2,9 @@ -- | Dataflow (fusion operations) module Data.Yarr.Flow (     -- * Basic fusion-    DefaultFusion(..),+    DefaultFusion(..), DefaultIFusion(..), -    -- ** 'D'elayed flow and zipping shortcuts+    -- ** Delayed flow and zipping shortcuts     dzipWith, dzipWith3, D, delay,      -- * Vector fusion@@ -17,6 +17,7 @@ ) where  import Data.Yarr.Base+import Data.Yarr.Fusion import Data.Yarr.Repr.Delayed import Data.Yarr.Repr.Separate import Data.Yarr.Utils.FixedVector as V@@ -50,7 +51,7 @@ -- @let φs = zipElems ('flip' 'atan2') coords@ zipElems     :: (Vector v a,-        USource r l sh (v a), USource fr l sh b, DefaultFusion r fr l)+        USource r l sh (v a), USource fr l sh b, DefaultFusion r fr l sh)     => Fn (Dim v) a b      -- ^ Unwrapped @n@-ary zipper function     -> UArray r l sh (v a) -- ^ Source array of vectors     -> UArray fr l sh b    -- ^ Result array@@ -69,7 +70,7 @@ -- @ mapElems     :: (VecRegular r slr l sh v a, USource slr l sh a,-        USource fslr l sh b, DefaultFusion slr fslr l, Vector v b)+        USource fslr l sh b, DefaultFusion slr fslr l sh, Vector v b)     => (a -> b)                     -- ^ Mapper function for all elements     -> UArray r l sh (v a)          -- ^ Source array of vectors     -> UArray (SE fslr) l sh (v b)  -- ^ Fused array of vectors@@ -84,7 +85,7 @@ -- @let domained = mapElemsM ('Data.Yarr.Utils.Primitive.clampM' 0.0 1.0) floatImage@ mapElemsM     :: (VecRegular r slr l sh v a, USource slr l sh a,-        USource fslr l sh b, DefaultFusion slr fslr l, Vector v b)+        USource fslr l sh b, DefaultFusion slr fslr l sh, Vector v b)     => (a -> IO b)                 -- ^ Monadic mapper for all vector elements     -> UArray r l sh (v a)         -- ^ Source array of vectors     -> UArray (SE fslr) l sh (v b) -- ^ Fused array of vectors@@ -102,9 +103,9 @@ -- Implemented by means of 'delay' function (source arrays are simply -- delayed before zipping). dzipWith-    :: (USource r1 l sh a, DefaultFusion r1 D l, USource D l sh a,-        USource r2 l sh b, DefaultFusion r2 D l, USource D l sh b,-        USource D l sh c, DefaultFusion D D l)+    :: (USource r1 l sh a, DefaultFusion r1 D l sh, USource D l sh a,+        USource r2 l sh b, DefaultFusion r2 D l sh, USource D l sh b,+        USource D l sh c, DefaultFusion D D l sh)     => (a -> b -> c)    -- ^ Pure zipping function     -> UArray r1 l sh a -- ^ 1st source array     -> UArray r2 l sh b -- ^ 2nd source array@@ -115,10 +116,10 @@ -- | /O(1)/ Generalized zipping of 3 arrays, which shouldn't be -- of the same representation type. dzipWith3-    :: (USource r1 l sh a, DefaultFusion r1 D l, USource D l sh a,-        USource r2 l sh b, DefaultFusion r2 D l, USource D l sh b,-        USource r3 l sh c, DefaultFusion r3 D l, USource D l sh c,-        USource D l sh d, DefaultFusion D D l)+    :: (USource r1 l sh a, DefaultFusion r1 D l sh, USource D l sh a,+        USource r2 l sh b, DefaultFusion r2 D l sh, USource D l sh b,+        USource r3 l sh c, DefaultFusion r3 D l sh, USource D l sh c,+        USource D l sh d, DefaultFusion D D l sh)     => (a -> b -> c -> d) -- ^ Pure zipping function     -> UArray r1 l sh a   -- ^ 1st source array     -> UArray r2 l sh b   -- ^ 2nd source array
+ Data/Yarr/Fusion.hs view
@@ -0,0 +1,346 @@+-- | Fusion type system. Use re-exported in "Data.Yarr.Flow" functions.+module Data.Yarr.Fusion where++import Prelude as P++import Data.Yarr.Base+import Data.Yarr.Shape as S+import Data.Yarr.Utils.FixedVector as V++-- | Generalized, non-injective version of 'DefaultFusion'. Used internally.+--+-- Minimum complete defenition: 'fmapM', 'fzip2M', 'fzip3M' and 'fzipM'.+--+-- The class doesn't have vector counterpart, it's role play top-level functions+-- from "Data.Yarr.Repr.Separate" module.+class Fusion r fr l sh where+    fmap :: (USource r l sh a, USource fr l sh b)+         => (a -> b) -- ^ .+         -> UArray r l sh a -> UArray fr l sh b+    fmap f = fmapM (return . f)+    +    fmapM :: (USource r l sh a, USource fr l sh b)+          => (a -> IO b) -> UArray r l sh a -> UArray fr l sh b++    fzip2 :: (USource r l sh a, USource r l sh b, USource fr l sh c)+          => (a -> b -> c) -- ^ .+          -> UArray r l sh a+          -> UArray r l sh b+          -> UArray fr l sh c+    fzip2 f = fzip2M (\x y -> return (f x y))++    fzip2M :: (USource r l sh a, USource r l sh b, USource fr l sh c)+           => (a -> b -> IO c) -- ^ .+           -> UArray r l sh a+           -> UArray r l sh b+           -> UArray fr l sh c++    fzip3 :: (USource r l sh a, USource r l sh b, USource r l sh c,+              USource fr l sh d)+          => (a -> b -> c -> d) -- ^ .+          -> UArray r l sh a+          -> UArray r l sh b+          -> UArray r l sh c+          -> UArray fr l sh d+    fzip3 f = fzip3M (\x y z -> return (f x y z))++    fzip3M :: (USource r l sh a, USource r l sh b, USource r l sh c,+               USource fr l sh d)+           => (a -> b -> c -> IO d) -- ^ .+           -> UArray r l sh a+           -> UArray r l sh b+           -> UArray r l sh c+           -> UArray fr l sh d++    fzip :: (USource r l sh a, USource fr l sh b, Arity n, n ~ S n0)+         => Fun n a b -- ^ .+         -> VecList n (UArray r l sh a) -> UArray fr l sh b+    fzip fun arrs = let funM = P.fmap return fun in fzipM funM arrs++    fzipM :: (USource r l sh a, USource fr l sh b, Arity n, n ~ S n0)+          => Fun n a (IO b) -- ^ .+          -> VecList n (UArray r l sh a) -> UArray fr l sh b++    {-# INLINE fmap #-}+    {-# INLINE fzip2 #-}+    {-# INLINE fzip3 #-}+    {-# INLINE fzip #-}+++-- | This class abstracts pair of array types, which could be (preferably should be)+-- mapped /(fused)/ one to another. Injective version of 'Fusion' class.+-- +-- Parameters:+--+--  * @r@ - source array representation. It determines result representation.+--+--  * @fr@ (fused repr) - result (fused) array representation. Result array+--    isn't indeed presented in memory, finally it should be+--    'Data.Yarr.Eval.compute'd or 'Data.Yarr.Eval.Load'ed to 'Data.Yarr.Base.Manifest'+--    representation.+--+--  * @l@ - load type, common for source and fused arrays+--+--  * @sh@ - shape of arrays+--+-- All functions are already defined, using non-injective versions from 'Fusion' class.+--+-- The class doesn't have vector counterpart, it's role play top-level functions+-- from "Data.Yarr.Repr.Separate" module.+class Fusion r fr l sh => DefaultFusion r fr l sh | r -> fr where+    -- | /O(1)/ Pure element mapping.+    --+    -- Main basic \"map\" in Yarr.+    dmap :: (USource r l sh a, USource fr l sh b)+         => (a -> b)         -- ^ Element mapper function+         -> UArray r l sh a  -- ^ Source array+         -> UArray fr l sh b -- ^ Result array+    dmap = Data.Yarr.Fusion.fmap+    +    -- | /O(1)/ Monadic element mapping.+    dmapM :: (USource r l sh a, USource fr l sh b)+          => (a -> IO b)      -- ^ Monadic element mapper function+          -> UArray r l sh a  -- ^ Source array+          -> UArray fr l sh b -- ^ Result array+    dmapM = fmapM++    -- | /O(1)/ Zipping 2 arrays of the same type indexes and shapes.+    -- +    -- Example:+    -- +    -- @+    -- let productArr = dzip2 (*) arr1 arr2+    -- @+    dzip2 :: (USource r l sh a, USource r l sh b, USource fr l sh c)+          => (a -> b -> c)     -- ^ Pure element zipper function+          -> UArray r l sh a   -- ^ 1st source array+          -> UArray r l sh b   -- ^ 2nd source array+          -> UArray fr l sh c  -- ^ Fused result array+    dzip2 = fzip2++    -- | /O(1)/ Monadic version of 'dzip2' function.+    dzip2M :: (USource r l sh a, USource r l sh b, USource fr l sh c)+           => (a -> b -> IO c) -- ^ Monadic element zipper function+           -> UArray r l sh a  -- ^ 1st source array+           -> UArray r l sh b  -- ^ 2nd source array+           -> UArray fr l sh c -- ^ Result array+    dzip2M = fzip2M++    -- | /O(1)/ Zipping 3 arrays of the same type indexes and shapes.+    dzip3 :: (USource r l sh a, USource r l sh b, USource r l sh c,+              USource fr l sh d)+          => (a -> b -> c -> d) -- ^ Pure element zipper function+          -> UArray r l sh a    -- ^ 1st source array+          -> UArray r l sh b    -- ^ 2nd source array+          -> UArray r l sh c    -- ^ 3rd source array+          -> UArray fr l sh d   -- ^ Result array+    dzip3 = fzip3++    -- | /O(1)/ Monadic version of 'dzip3' function.+    dzip3M :: (USource r l sh a, USource r l sh b, USource r l sh c,+               USource fr l sh d)+           => (a -> b -> c -> IO d) -- ^ Monadic element zipper function+           -> UArray r l sh a       -- ^ 1st source array+           -> UArray r l sh b       -- ^ 2nd source array+           -> UArray r l sh c       -- ^ 3rd source array+           -> UArray fr l sh d      -- ^ Fused result array+    dzip3M = fzip3M++    -- | /O(1)/ Generalized element zipping with pure function.+    -- Zipper function is wrapped in 'Fun' for injectivity.+    dzip :: (USource r l sh a, USource fr l sh b, Arity n, n ~ S n0)+         => Fun n a b                   -- ^ Wrapped function positionally+                                        -- accepts elements from source arrays+                                        -- and emits element for fused array+         -> VecList n (UArray r l sh a) -- ^ Source arrays+         -> UArray fr l sh b            -- ^ Result array+    dzip = fzip++    -- | /O(1)/ Monadic version of 'dzip' function.+    dzipM :: (USource r l sh a, USource fr l sh b, Arity n, n ~ S n0)+          => Fun n a (IO b)              -- ^ Wrapped monadic zipper+          -> VecList n (UArray r l sh a) -- ^ Source arrays+          -> UArray fr l sh b            -- ^ Result array+    dzipM = fzipM++    {-# INLINE dmap #-}+    {-# INLINE dmapM #-}+    {-# INLINE dzip2 #-}+    {-# INLINE dzip2M #-}+    {-# INLINE dzip3 #-}+    {-# INLINE dzip3M #-}+    {-# INLINE dzip #-}+    {-# INLINE dzipM #-}++-- | Like 'Fusion', for mappings/zippings with array index. Used to define+-- functions in 'DefaultIFusion'.+-- +-- Minimum complete defenition: 'fimapM', 'fizip2M', 'fizip3M' and 'fizipM'.+--+-- The class doesn't have vector counterpart.+class PreferredWorkIndex fl sh sh => IFusion r l fr fl sh | r l fr -> fl where+    fimap :: (USource r l sh a, USource fr fl sh b)+          => (sh -> a -> b) -- ^ .+          -> UArray r l sh a -> UArray fr fl sh b+    fimap f = fimapM (\i x -> return (f i x))+    +    fimapM :: (USource r l sh a, USource fr fl sh b)+           => (sh -> a -> IO b) -> UArray r l sh a -> UArray fr fl sh b++    fizip2 :: (USource r l sh a, USource r l sh b, USource fr fl sh c)+           => (sh -> a -> b -> c) -- ^ .+           -> UArray r l sh a+           -> UArray r l sh b+           -> UArray fr fl sh c+    fizip2 f = fizip2M (\i x y -> return (f i x y))++    fizip2M :: (USource r l sh a, USource r l sh b, USource fr fl sh c)+            => (sh -> a -> b -> IO c) -- ^ .+            -> UArray r l sh a+            -> UArray r l sh b+            -> UArray fr fl sh c++    fizip3 :: (USource r l sh a, USource r l sh b, USource r l sh c,+               USource fr fl sh d)+           => (sh -> a -> b -> c -> d) -- ^ .+           -> UArray r l sh a+           -> UArray r l sh b+           -> UArray r l sh c+           -> UArray fr fl sh d+    fizip3 f = fizip3M (\i x y z -> return (f i x y z))++    fizip3M :: (USource r l sh a, USource r l sh b, USource r l sh c,+                USource fr fl sh d)+            => (sh -> a -> b -> c -> IO d) -- ^ .+            -> UArray r l sh a+            -> UArray r l sh b+            -> UArray r l sh c+            -> UArray fr fl sh d++    fizip :: (USource r l sh a, USource fr fl sh b, Arity n, n ~ S n0)+          => (sh -> Fun n a b) -- ^ .+          -> VecList n (UArray r l sh a) -> UArray fr fl sh b+    fizip fun arrs = fizipM funM arrs+      where funM i = P.fmap return (fun i)++    fizipM :: (USource r l sh a, USource fr fl sh b, Arity n, n ~ S n0)+           => (sh -> Fun n a (IO b)) -- ^ .+           -> VecList n (UArray r l sh a) -> UArray fr fl sh b++    {-# INLINE fimap #-}+    {-# INLINE fizip2 #-}+    {-# INLINE fizip3 #-}+    {-# INLINE fizip #-}++-- | Like 'DefaultFusion', this class abstracts the pair array types,+-- which should be fused one to another+-- on maps and zips which accept index of element+-- (several elements for zips) in array (arrays).+--+-- Parameters:+--+--  * @r@ - source array representation. Determines result representation.+--+--  * @l@ - source load type+--+--  * @fr@ (fused repr) - result (fused) array representation. Result array+--    isn't indeed presented in memory, finally it should be+--    'Data.Yarr.Eval.compute'd or 'Data.Yarr.Eval.Load'ed to 'Data.Yarr.Base.Manifest'+--    representation.+--+--  * @fl@ - result, \"shaped\" load type+--+--  * @sh@ - shape of arrays+--+-- All functions are already defined,+-- using non-injective versions from 'IFusion' class.+--+-- The class doesn't have vector counterpart.+class IFusion r l fr fl sh => DefaultIFusion r l fr fl sh | r l -> fr where+    -- | /O(1)/ Pure element mapping with array index.+    imap :: (USource r l sh a, USource fr fl sh b)+         => (sh -> a -> b)    -- ^ Indexed mapping function+         -> UArray r l sh a   -- ^ Source array+         -> UArray fr fl sh b -- ^ Fused result array+    imap = fimap+    +    -- | /O(1)/ Monadic element mapping with index.+    imapM :: (USource r l sh a, USource fr fl sh b)+          => (sh -> a -> IO b) -- ^ Indexed monadic mapping function+          -> UArray r l sh a   -- ^ Source array+          -> UArray fr fl sh b -- ^ Result fused array+    imapM = fimapM++    -- | /O(1)/ Pure zipping of 2 arrays with index.+    izip2 :: (USource r l sh a, USource r l sh b, USource fr fl sh c)+          => (sh -> a -> b -> c) -- ^ Indexed zipping function+          -> UArray r l sh a     -- ^ 1st source array+          -> UArray r l sh b     -- ^ 2nd source array+          -> UArray fr fl sh c   -- ^ Fused result array+    izip2 = fizip2++    -- | /O(1)/ Monadic zipping of 2 arrays with index.+    izip2M :: (USource r l sh a, USource r l sh b, USource fr fl sh c)+           => (sh -> a -> b -> IO c) -- ^ Indexed monadic zipping function+           -> UArray r l sh a        -- ^ 1st source array+           -> UArray r l sh b        -- ^ 2nd source array+           -> UArray fr fl sh c      -- ^ Fused result array+    izip2M = fizip2M++    -- | /O(1)/ Pure zipping of 3 arrays with index.+    izip3 :: (USource r l sh a, USource r l sh b, USource r l sh c,+               USource fr fl sh d)+          => (sh -> a -> b -> c -> d) -- ^ Indexed zipping function+          -> UArray r l sh a          -- ^ 1st source array+          -> UArray r l sh b          -- ^ 2nd source array+          -> UArray r l sh c          -- ^ 3rd source array+          -> UArray fr fl sh d        -- ^ Fused result array+    izip3 = fizip3++    -- | /O(1)/ Monadic zipping of 3 arrays with index.+    izip3M :: (USource r l sh a, USource r l sh b, USource r l sh c,+                USource fr fl sh d)+           => (sh -> a -> b -> c -> IO d) -- ^ Indexed monadic zipping function+           -> UArray r l sh a             -- ^ 1st source array+           -> UArray r l sh b             -- ^ 2nd source array+           -> UArray r l sh c             -- ^ 3rd source array+           -> UArray fr fl sh d           -- ^ Fused result array+    izip3M = fizip3M++    -- | /O(1)/ Generalized pure element zipping with index in arrays.+    -- Zipper function is wrapped in 'Fun' for injectivity.+    izip :: (USource r l sh a, USource fr fl sh b, Arity n, n ~ S n0)+         => (sh -> Fun n a b)           -- ^ Accepts index in array and returns+                                        -- wrapped zipper, which positionally+                                        -- accepts elements from source arrays+                                        -- and emits element for the result array+         -> VecList n (UArray r l sh a) -- ^ Bunch of source arrays+         -> UArray fr fl sh b           -- ^ Result fused array+    izip = fizip++    -- | /O(1)/ Monadic version of 'izip' function.+    izipM :: (USource r l sh a, USource fr fl sh b, Arity n, n ~ S n0)+          => (sh -> Fun n a (IO b))      -- ^ Monadic indexed zipper+          -> VecList n (UArray r l sh a) -- ^ Source arrays+          -> UArray fr fl sh b           -- ^ Result fused array+    izipM = fizipM++    {-# INLINE imap #-}+    {-# INLINE imapM #-}+    {-# INLINE izip2 #-}+    {-# INLINE izip2M #-}+    {-# INLINE izip3 #-}+    {-# INLINE izip3M #-}+    {-# INLINE izip #-}+    {-# INLINE izipM #-}+++instance IFusion r l fr l sh => Fusion r fr l sh where+   fmapM f = fimapM (\_ x -> f x)+   fzip2M f = fizip2M (\_ x y -> f x y)+   fzip3M f = fizip3M (\_ x y z -> f x y z)+   fzipM funM = fizipM (\_ -> funM)+   {-# INLINE fmapM #-}+   {-# INLINE fzip2M #-}+   {-# INLINE fzip3M #-}+   {-# INLINE fzipM #-}
Data/Yarr/IO/List.hs view
@@ -6,7 +6,7 @@ import Data.Yarr.Base import Data.Yarr.Shape as S import Data.Yarr.Eval-import Data.Yarr.Work+import Data.Yarr.Walk  import Debug.Yarr @@ -18,7 +18,7 @@     :: (USource r l sh a, PreferredWorkIndex l sh i)     => UArray r l sh a -> IO [a] {-# INLINE toList #-}-toList = work (reduceR S.foldr (:)) (return [])+toList = walk (reduceR S.foldr (:)) (return [])  -- | /O(n)/ Loads manifest array into memory, with elements -- from flatten list.
Data/Yarr/Repr/Boxed.hs view
@@ -13,7 +13,8 @@ import Control.Monad.ST (RealWorld) import Data.Primitive.Array -import Data.Yarr.Base hiding (fmap)+import Data.Yarr.Base+import Data.Yarr.Fusion hiding (fmap) import Data.Yarr.Shape import Data.Yarr.Repr.Delayed import Data.Yarr.Repr.Separate@@ -46,7 +47,8 @@     linearIndex (Boxed _ arr) = indexArrayM arr     {-# INLINE linearIndex #-} -instance DefaultFusion B D L+instance DefaultFusion B D L sh+instance Shape sh => DefaultIFusion B L D SH sh  instance (Shape sh, Vector v e, NFData e) => UVecSource (SE B) B L sh v e @@ -70,7 +72,8 @@     linearIndex (MutableBoxed _ marr) = readArray marr     {-# INLINE linearIndex #-} -instance DefaultFusion MB D L+instance DefaultFusion MB D L sh+instance Shape sh => DefaultIFusion MB L D SH sh  instance (Shape sh, Vector v e, NFData e) => UVecSource (SE MB) MB L sh v e
Data/Yarr/Repr/Delayed.hs view
@@ -19,7 +19,8 @@ import Prelude as P import Control.Monad -import Data.Yarr.Base as B+import Data.Yarr.Base+import Data.Yarr.Fusion as F import Data.Yarr.Eval import Data.Yarr.Shape import Data.Yarr.Utils.FixedVector as V@@ -68,7 +69,7 @@  instance (Shape sh, Vector v e) => UVecSource D D L sh v e -instance Fusion r D L where+instance Fusion r D L sh where     fmapM f arr =         LinearDelayed             (extent arr) (touchArray arr) (force arr) (f <=< linearIndex arr)@@ -124,7 +125,7 @@     {-# INLINE fzip3M #-}     {-# INLINE fzipM #-} -instance DefaultFusion D D L+instance DefaultFusion D D L sh   @@ -163,12 +164,13 @@  instance (Shape sh, Vector v e) => UVecSource D D SH sh v e -instance Fusion r D SH where-    fmapM f arr =+instance Shape sh => IFusion r l D SH sh where+    fimapM f arr =         ShapeDelayed-            (extent arr) (touchArray arr) (force arr) (f <=< index arr)+            (extent arr) (touchArray arr) (force arr)+            (\sh -> index arr sh >>= f sh) -    fzip2M f arr1 arr2 =+    fizip2M f arr1 arr2 =         let sh = intersect (vl_2 (extent arr1) (extent arr2))             tch = touchArray arr1 >> touchArray arr2             iforce = force arr1 >> force arr2@@ -177,11 +179,11 @@             get sh = do                 v1 <- index arr1 sh                 v2 <- index arr2 sh-                f v1 v2+                f sh v1 v2          in ShapeDelayed sh tch iforce get -    fzip3M f arr1 arr2 arr3 =+    fizip3M f arr1 arr2 arr3 =         let sh = intersect (vl_3 (extent arr1) (extent arr2) (extent arr3))             tch = touchArray arr1 >> touchArray arr2 >> touchArray arr3             iforce = force arr1 >> force arr2 >> force arr3@@ -191,11 +193,11 @@                 v1 <- index arr1 sh                 v2 <- index arr2 sh                 v3 <- index arr3 sh-                f v1 v2 v3+                f sh v1 v2 v3          in ShapeDelayed sh tch iforce get -    fzipM fun arrs =+    fizipM ifun arrs =         let shapes = V.map extent arrs             sh = intersect shapes @@ -207,22 +209,24 @@             {-# INLINE get #-}             get sh = do                 v <- V.mapM ($ sh) gets-                inspect v fun+                inspect v (ifun sh)          in ShapeDelayed sh tch iforce get -    {-# INLINE fmapM #-}-    {-# INLINE fzip2M #-}-    {-# INLINE fzip3M #-}-    {-# INLINE fzipM #-}+    {-# INLINE fimapM #-}+    {-# INLINE fizip2M #-}+    {-# INLINE fizip3M #-}+    {-# INLINE fizipM #-} -instance DefaultFusion D D SH+instance Shape sh => DefaultIFusion D L D SH sh+instance Shape sh => DefaultIFusion D SH D SH sh+instance Shape sh => DefaultFusion D D SH sh  -- | Load type preserving wrapping arbirtary array into 'D'elayed representation.-delay :: (USource r l sh a, USource D l sh a, Fusion r D l)+delay :: (USource r l sh a, USource D l sh a, Fusion r D l sh)       => UArray r l sh a -> UArray D l sh a {-# INLINE delay #-}-delay = B.fmap id+delay = F.fmap id  -- | Wrap indexing function into delayed representation. --
Data/Yarr/Repr/Foreign.hs view
@@ -20,6 +20,7 @@ import Foreign.Marshal.MissingAlloc  import Data.Yarr.Base as B+import Data.Yarr.Fusion import Data.Yarr.Repr.Delayed import Data.Yarr.Repr.Separate import Data.Yarr.Shape@@ -66,7 +67,8 @@     linearIndex (ForeignArray _ _ ptr) i = peekElemOff ptr i     {-# INLINE linearIndex #-} -instance DefaultFusion F D L+instance DefaultFusion F D L sh+instance Shape sh => DefaultIFusion F L D SH sh  -- | Foreign Slice representation, /view/ slice representation -- for 'F'oreign arrays.@@ -120,7 +122,8 @@     linearIndex (ForeignSlice _ vsize _ ptr) i = peekByteOff ptr (i * vsize)     {-# INLINE linearIndex #-} -instance DefaultFusion FS D L+instance DefaultFusion FS D L sh+instance Shape sh => DefaultIFusion FS L D SH sh   instance (Shape sh, Vector v e, Storable e) => VecRegular F FS L sh v e where
Data/Yarr/Repr/Separate.hs view
@@ -27,6 +27,7 @@ import Data.Functor ((<$>))  import Data.Yarr.Base as B+import Data.Yarr.Fusion import Data.Yarr.Shape import Data.Yarr.Repr.Delayed import Data.Yarr.Utils.FixedVector as V@@ -77,14 +78,18 @@  instance (USource r l sh e, Vector v e) => UVecSource (SE r) r l sh v e -instance (DefaultFusion r D l, Fusion (SE r) D l) => DefaultFusion (SE r) D l+instance (DefaultFusion r D l sh, Fusion (SE r) D l sh) =>+        DefaultFusion (SE r) D l sh +instance (DefaultIFusion r l D SH sh, IFusion (SE r) l D SH sh) =>+        DefaultIFusion (SE r) l D SH sh + -- | Group of @f-...-Elems-@ functions is used internally to define -- @d-...-Elems-@ functions. fmapElems     :: (VecRegular r slr l sh v a,-        USource slr l sh a, USource fslr l sh b, Fusion slr fslr l,+        USource slr l sh a, USource fslr l sh b, Fusion slr fslr l sh,         Vector v2 b, Dim v ~ Dim v2)     => VecList (Dim v) (a -> b) -- ^ .     -> UArray r l sh (v a)@@ -93,7 +98,7 @@  fmapElemsM     :: (VecRegular r slr l sh v a,-        USource slr l sh a, USource fslr l sh b, Fusion slr fslr l,+        USource slr l sh a, USource fslr l sh b, Fusion slr fslr l sh,         Vector v2 b, Dim v ~ Dim v2)     => VecList (Dim v) (a -> IO b) -- ^ .     -> UArray r l sh (v a)@@ -104,7 +109,7 @@ fzipElems2     :: (VecRegular r slr l sh v a, USource slr l sh a,         VecRegular r slr l sh v b, USource slr l sh b,-        USource fslr l sh c, Fusion slr fslr l, Vector v c)+        USource fslr l sh c, Fusion slr fslr l sh, Vector v c)     => VecList (Dim v) (a -> b -> c) -- ^ .     -> UArray r l sh (v a)     -> UArray r l sh (v b)@@ -116,7 +121,7 @@ fzipElems2M     :: (VecRegular r slr l sh v a, USource slr l sh a,         VecRegular r slr l sh v b, USource slr l sh b,-        USource fslr l sh c, Fusion slr fslr l, Vector v c)+        USource fslr l sh c, Fusion slr fslr l sh, Vector v c)     => VecList (Dim v) (a -> b -> IO c) -- ^ .     -> UArray r l sh (v a)     -> UArray r l sh (v b)@@ -136,7 +141,7 @@     :: (VecRegular r slr l sh v a, USource slr l sh a,         VecRegular r slr l sh v b, USource slr l sh b,         VecRegular r slr l sh v c, USource slr l sh c,-        USource fslr l sh d, Fusion slr fslr l, Vector v d)+        USource fslr l sh d, Fusion slr fslr l sh, Vector v d)     => VecList (Dim v) (a -> b -> c -> d) -- ^ .     -> UArray r l sh (v a)     -> UArray r l sh (v b)@@ -150,7 +155,7 @@     :: (VecRegular r slr l sh v a, USource slr l sh a,         VecRegular r slr l sh v b, USource slr l sh b,         VecRegular r slr l sh v c, USource slr l sh c,-        USource fslr l sh d, Fusion slr fslr l, Vector v d)+        USource fslr l sh d, Fusion slr fslr l sh, Vector v d)     => VecList (Dim v) (a -> b -> c -> IO d) -- ^ .     -> UArray r l sh (v a)     -> UArray r l sh (v b)@@ -173,7 +178,7 @@ fzipElems     :: (Vector v2 b, Arity m, m ~ S m0,         VecRegular r slr l sh v a,-        USource slr l sh a, USource fslr l sh b, Fusion slr fslr l)+        USource slr l sh a, USource fslr l sh b, Fusion slr fslr l sh)     => VecList (Dim v2) (Fun m a b) -- ^ .     -> VecList m (UArray r l sh (v a))     -> UArray (SE fslr) l sh (v2 b)@@ -184,7 +189,7 @@ fzipElemsM     :: (Vector v2 b, Arity m, m ~ S m0,         VecRegular r slr l sh v a,-        USource slr l sh a, USource fslr l sh b, Fusion slr fslr l)+        USource slr l sh a, USource fslr l sh b, Fusion slr fslr l sh)     => VecList (Dim v2) (Fun m a (IO b)) -- ^ .     -> VecList m (UArray r l sh (v a))     -> UArray (SE fslr) l sh (v2 b)@@ -219,7 +224,7 @@ -- Also, used internally to define 'Data.Yarr.Flow.mapElems' function. dmapElems     :: (VecRegular r slr l sh v a,-        USource slr l sh a, USource fslr l sh b, DefaultFusion slr fslr l,+        USource slr l sh a, USource fslr l sh b, DefaultFusion slr fslr l sh,         Vector v2 b, Dim v ~ Dim v2)     => VecList (Dim v) (a -> b)     -- ^ Vector of mapper functions     -> UArray r l sh (v a)          -- ^ Source array of vectors@@ -229,7 +234,7 @@ -- | /O(1)/ Monadic vesion of 'dmapElems' function. dmapElemsM     :: (VecRegular r slr l sh v a,-        USource slr l sh a, USource fslr l sh b, DefaultFusion slr fslr l,+        USource slr l sh a, USource fslr l sh b, DefaultFusion slr fslr l sh,         Vector v2 b, Dim v ~ Dim v2)     => VecList (Dim v) (a -> IO b)  -- ^ Elemen-wise vector of monadic mappers     -> UArray r l sh (v a)          -- ^ Source array of vectors@@ -240,7 +245,7 @@ dzipElems2     :: (VecRegular r slr l sh v a, USource slr l sh a,         VecRegular r slr l sh v b, USource slr l sh b,-        USource fslr l sh c, DefaultFusion slr fslr l, Vector v c)+        USource fslr l sh c, DefaultFusion slr fslr l sh, Vector v c)     => VecList (Dim v) (a -> b -> c) -- ^ .     -> UArray r l sh (v a)     -> UArray r l sh (v b)@@ -250,7 +255,7 @@ dzipElems2M     :: (VecRegular r slr l sh v a, USource slr l sh a,         VecRegular r slr l sh v b, USource slr l sh b,-        USource fslr l sh c, DefaultFusion slr fslr l, Vector v c)+        USource fslr l sh c, DefaultFusion slr fslr l sh, Vector v c)     => VecList (Dim v) (a -> b -> IO c) -- ^ .     -> UArray r l sh (v a)     -> UArray r l sh (v b)@@ -261,7 +266,7 @@     :: (VecRegular r slr l sh v a, USource slr l sh a,         VecRegular r slr l sh v b, USource slr l sh b,         VecRegular r slr l sh v c, USource slr l sh c,-        USource fslr l sh d, DefaultFusion slr fslr l, Vector v d)+        USource fslr l sh d, DefaultFusion slr fslr l sh, Vector v d)     => VecList (Dim v) (a -> b -> c -> d) -- ^ .     -> UArray r l sh (v a)     -> UArray r l sh (v b)@@ -273,7 +278,7 @@     :: (VecRegular r slr l sh v a, USource slr l sh a,         VecRegular r slr l sh v b, USource slr l sh b,         VecRegular r slr l sh v c, USource slr l sh c,-        USource fslr l sh d, DefaultFusion slr fslr l, Vector v d)+        USource fslr l sh d, DefaultFusion slr fslr l sh, Vector v d)     => VecList (Dim v) (a -> b -> c -> IO d) -- ^ .     -> UArray r l sh (v a)     -> UArray r l sh (v b)@@ -287,7 +292,7 @@ dzipElems     :: (Vector v2 b, Arity m, m ~ S m0,         VecRegular r slr l sh v a,-        USource slr l sh a, USource fslr l sh b, DefaultFusion slr fslr l)+        USource slr l sh a, USource fslr l sh b, DefaultFusion slr fslr l sh)     => VecList (Dim v2) (Fun m a b)    -- ^ Vector of wrapped @m-@ary element-wise zippers     -> VecList m (UArray r l sh (v a)) -- ^ Vector of source arrays of vectors     -> UArray (SE fslr) l sh (v2 b)    -- ^ Fused result array@@ -297,7 +302,7 @@ dzipElemsM     :: (Vector v2 b, Arity m, m ~ S m0,         VecRegular r slr l sh v a,-        USource slr l sh a, USource fslr l sh b, DefaultFusion slr fslr l)+        USource slr l sh a, USource fslr l sh b, DefaultFusion slr fslr l sh)     => VecList (Dim v2) (Fun m a (IO b)) -- ^ Vector of wrapped @m-@ary                                          -- element-wise monadic zippers     -> VecList m (UArray r l sh (v a))   -- ^ Vector of source arrays of vectors
Data/Yarr/Shape.hs view
@@ -12,6 +12,9 @@      -- * Specialized flow     dim2BlockFill,++    -- * Touch functions+    Touchable(..), noTouch, ) where  import Prelude as P hiding (foldl, foldr)
Data/Yarr/Utils/Fork.hs view
@@ -10,11 +10,12 @@  makeForkEachSlice     :: (Shape sh, Arity n, v ~ VecList n)-    => Int               -- ^ Number of threads to fork work on-    -> sh                -- ^ Start-    -> sh                -- ^ End-    -> v (Work sh a)     -- ^ Slice works-    -> (Int -> IO (v a)) -- ^ Thread work, returns piece of result for each slice+    => Int               -- ^ Number of threads to fork the work on+    -> sh                -- ^ Lower bound+    -> sh                -- ^ Upper bound+    -> v (Work sh a)     -- ^ Per-slice interval works+    -> (Int -> IO (v a)) -- ^ Producer of per-thread work,+                         -- which returns piece of result for each slice {-# INLINE makeForkEachSlice #-} makeForkEachSlice threads start end rangeWorks =     let {-# INLINE etWork #-}@@ -24,11 +25,11 @@  makeForkSlicesOnce     :: (Shape sh, Arity n)-    => Int                    -- ^ Number of threads to fork work on-    -> VecList n (sh, sh)     -- ^ (start, end) for each slice-    -> VecList n (Work sh a)  -- ^ Slice works-    -> (Int -> IO [(Int, a)]) -- ^ Thread work, returns pieces of results:-                              -- [(slice number, result)]+    => Int                    -- ^ Number of threads to fork the work on+    -> VecList n (sh, sh)     -- ^ (lower bound, upper bound) for each slice+    -> VecList n (Work sh a)  -- ^ Per-slice interval works+    -> (Int -> IO [(Int, a)]) -- ^ Producer of per-thread work,+                              -- which returns pieces of results: [(slice number, result)] {-# INLINE makeForkSlicesOnce #-} makeForkSlicesOnce !threads ranges rangeWorks =     let !slices = V.length rangeWorks@@ -74,11 +75,11 @@  makeFork     :: Shape sh-    => Int            -- ^ Number of threads to fork work on-    -> sh             -- ^ Start-    -> sh             -- ^ End-    -> (Work sh a)    -- ^ Work-    -> (Int -> IO a)  -- ^ Thread work+    => Int            -- ^ Number of threads to fork the work on+    -> sh             -- ^ Lower bound+    -> sh             -- ^ Upper bound+    -> (Work sh a)    -- ^ Interval work+    -> (Int -> IO a)  -- ^ Producer of per-thread work {-# INLINE makeFork #-} makeFork chunks start end =     let {-# INLINE chunkRange #-}
+ Data/Yarr/Walk.hs view
@@ -0,0 +1,274 @@++module Data.Yarr.Walk (+    -- * Fold combinators+    -- | See source of these 4 functions+    -- to construct more similar ones,+    -- if you need.+    reduceL, reduceLeftM,+    reduceR, reduceRightM,++    -- * Combinators to walk with mutable state+    -- | Added specially to improve performance+    -- of tasks like histogram filling.+    --+    -- Unfortunately, GHC doesn't figure that folding state+    -- isn't changed as ADT in such cases and doesn't lift+    -- it's evaluation higher from folding routine.+    mutate, imutate,++    -- * Walk runners+    walk, iwalk, rangeWalk,+    walkP, iwalkP, rangeWalkP,+    walkSlicesSeparate, iwalkSlicesSeparate, rangeWalkSlicesSeparate,+    walkSlicesSeparateP, iwalkSlicesSeparateP, rangeWalkSlicesSeparateP,++    -- * Aliases for walk types+    StatefulWalk, Foldl, Foldr,+) where++import Data.Yarr.Base+import Data.Yarr.Shape as S+import Data.Yarr.Eval++import Data.Yarr.Walk.Internal+++-- | /O(0)/+reduceLeftM+    :: Foldl i a b        -- ^ 'S.foldl' or curried 'S.unrolledFoldl'+    -> (b -> a -> IO b)   -- ^ Monadic left reduce+    -> StatefulWalk i a b -- ^ Result stateful walk to be passed+                          -- to walk runners+{-# INLINE reduceLeftM #-}+reduceLeftM foldl rf = foldl (\b _ a -> rf b a)++-- | /O(0)/+reduceL+    :: Foldl i a b        -- ^ 'S.foldl' or curried 'S.unrolledFoldl'+    -> (b -> a -> b)      -- ^ Pure left reduce+    -> StatefulWalk i a b -- ^ Result stateful walk to be passed+                          -- to walk runners+{-# INLINE reduceL #-}+reduceL foldl rf = foldl (\b _ a -> return $ rf b a)++-- | /O(0)/+reduceRightM+    :: Foldr i a b         -- ^ 'S.foldr' or curried 'S.unrolledFoldr'+    -> (a -> b -> IO b)    -- ^ Monadic right reduce+    -> StatefulWalk i a b  -- ^ Result stateful walk to be passed+                           -- to walk runners+{-# INLINE reduceRightM #-}+reduceRightM foldr rf = foldr (\_ a b -> rf a b)++-- | /O(0)/+reduceR+    :: Foldr i a b        -- ^ 'S.foldr' or curried 'S.unrolledFoldr'+    -> (a -> b -> b)      -- ^ Pure right reduce+    -> StatefulWalk i a b -- ^ Result stateful walk to be passed+                          -- to walk runners+{-# INLINE reduceR #-}+reduceR foldr rf = foldr (\_ a b -> return $ rf a b)+++-- | /O(0)/+mutate+    :: Fill i a           -- ^ 'S.fill' or curried 'S.unrolledFill'.+                          -- If mutating is associative,+                          -- 'S.dim2BlockFill' is also acceptable.+    -> (s -> a -> IO ())  -- ^ (state -> array element -> (state has changed))+                          -- -- State mutating function+    -> StatefulWalk i a s -- ^ Result stateful walk to be passed+                          -- to walk runners+{-# INLINE mutate #-}+mutate fill mf = imutate fill (\s i -> mf s)++-- | /O(0)/ Version of 'mutate', accepts mutating function+-- which additionaly accepts array index.+imutate+    :: Fill i a               -- ^ 'S.fill' or curried 'S.unrolledFill'.+                              -- If mutating is associative,+                              -- 'S.dim2BlockFill' is also acceptable.+    -> (s -> i -> a -> IO ()) -- ^ Indexed state mutating function+    -> StatefulWalk i a s     -- ^ Result stateful walk to be passed+                              -- to walk runners+{-# INLINE imutate #-}+imutate fill imf ms index start end = do+    s <- ms+    fill index (imf s) start end+    return s++++-- | /O(n)/ Walk with state,+-- with non-indexed function ('reduceL' group of fold combinators, 'mutate').+--+-- Example:+--+-- @'Data.Yarr.IO.List.toList' = walk ('reduceR' 'S.foldr' (:)) (return [])@+walk+    :: (USource r l sh a, PreferredWorkIndex l sh i)+    => StatefulWalk i a s -- ^ Stateful walking function+    -> IO s               -- ^ Monadic initial state (fold zero).+                          -- Wrap pure state in 'return'.+    -> UArray r l sh a    -- ^ Source array+    -> IO s               -- ^ Final state (fold result)+{-# INLINE walk #-}+walk = anyWalk++-- | /O(n)/ Walk with state,+-- with indexed function ('S.foldl', 'S.foldr', 'imutate', etc).+--+-- Example:+--+-- @res \<- iwalk ('S.foldl' (\\s i a -> ...)) foldZero sourceArray@+iwalk+    :: USource r l sh a+    => StatefulWalk sh a s -- ^ Stateful walking function+    -> IO s                -- ^ Monadic initial state (fold zero).+                           -- Wrap pure state in 'return'.+    -> UArray r l sh a     -- ^ Source array+    -> IO s                -- ^ Final state (fold result)+{-# INLINE iwalk #-}+iwalk = anyWalk++-- | /O(n)/ Walk with state, in specified range of indices.+rangeWalk+    :: USource r l sh a+    => StatefulWalk sh a s -- ^ Stateful walking function+    -> IO s                -- ^ Monadic initial state (fold zero).+                           -- Wrap pure state in 'return'.+    -> UArray r l sh a     -- ^ Source array+    -> sh                  -- ^ Top-left+    -> sh                  -- ^ and bottom-right corners of range to walk in+    -> IO s                -- ^ Final state (fold result)+{-# INLINE rangeWalk #-}+rangeWalk = anyRangeWalk+++-- | /O(n)/ Run associative non-indexed stateful walk, in parallel.+--+-- Example -- associative image histogram filling in the test:+-- <https://github.com/leventov/yarr/blob/master/tests/lum-equalization.hs>+walkP+    :: (USource r l sh a, PreferredWorkIndex l sh i)+    => Threads            -- ^ Number of threads to parallelize walk on+    -> StatefulWalk i a s -- ^ Associative stateful walking function+    -> IO s               -- ^ Monadic zero state.+                          -- Wrap pure state in 'return'.+    -> (s -> s -> IO s)   -- ^ Associative monadic state joining function+    -> UArray r l sh a    -- ^ Source array+    -> IO s               -- ^ Gathered state (fold result)+{-# INLINE walkP #-}+walkP = anyWalkP++-- | /O(n)/ Run associative indexed stateful walk, in parallel.+iwalkP+    :: USource r l sh a+    => Threads             -- ^ Number of threads to parallelize walk on+    -> StatefulWalk sh a s -- ^ Associative stateful walking function+    -> IO s                -- ^ Monadic zero state.+                           -- Wrap pure state in 'return'.+    -> (s -> s -> IO s)    -- ^ Associative monadic state joining function+    -> UArray r l sh a     -- ^ Source array+    -> IO s                -- ^ Gathered state (fold result)+{-# INLINE iwalkP #-}+iwalkP = anyWalkP++-- | /O(n)/ Run associative stateful walk in specified range, in parallel.+rangeWalkP+    :: USource r l sh a+    => Threads             -- ^ Number of threads to parallelize walk on+    -> StatefulWalk sh a s -- ^ Associative stateful walking function+    -> IO s                -- ^ Monadic zero state.+                           -- Wrap pure state in 'return'.+    -> (s -> s -> IO s)    -- ^ Associative monadic state joining function+    -> UArray r l sh a     -- ^ Source array+    -> sh                  -- ^ Top-left+    -> sh                  -- ^ and bottom-right corners of range to walk in+    -> IO s                -- ^ Gathered state (fold result)+{-# INLINE rangeWalkP #-}+rangeWalkP = anyRangeWalkP+++-- | /O(n)/ Walk with state, with non-indexed function,+-- over each slice of array of vectors.+walkSlicesSeparate+    :: (UVecSource r slr l sh v e, PreferredWorkIndex l sh i)+    => StatefulWalk i e s     -- ^ Stateful slice-wise walking function+    -> IO s                   -- ^ Monadic initial state (fold zero).+                              -- Wrap pure state in 'return'.+    -> UArray r l sh (v e)    -- ^ Source array of vectors+    -> IO (VecList (Dim v) s) -- ^ Vector of final states (fold results)+{-# INLINE walkSlicesSeparate #-}+walkSlicesSeparate = anyWalkSlicesSeparate++-- | /O(n)/ Walk with state, with indexed function,+-- over each slice of array of vectors.+iwalkSlicesSeparate+    :: UVecSource r slr l sh v e+    => StatefulWalk sh e s    -- ^ Stateful slice-wise walking function+    -> IO s                   -- ^ Monadic initial state (fold zero).+                              -- Wrap pure state in 'return'.+    -> UArray r l sh (v e)    -- ^ Source array of vectors+    -> IO (VecList (Dim v) s) -- ^ Vector of final states (fold results)+{-# INLINE iwalkSlicesSeparate #-}+iwalkSlicesSeparate = anyWalkSlicesSeparate++-- | /O(n)/ Walk with state, in specified range of indices,+-- over each slice of array of vectors.+rangeWalkSlicesSeparate+    :: UVecSource r slr l sh v e+    => StatefulWalk sh e s    -- ^ Stateful slice-wise walking function+    -> IO s                   -- ^ Monadic initial state (fold zero).+                              -- Wrap pure state in 'return'.+    -> UArray r l sh (v e)    -- ^ Source array of vectors+    -> sh                     -- ^ Top-left+    -> sh                     -- ^ and bottom-right corners of range to walk in+    -> IO (VecList (Dim v) s) -- ^ Vector of final states (fold results)+{-# INLINE rangeWalkSlicesSeparate #-}+rangeWalkSlicesSeparate = anyRangeWalkSlicesSeparate+++-- | /O(n)/ Run associative non-indexed stateful walk+-- over slices of array of vectors, in parallel.+walkSlicesSeparateP+    :: (UVecSource r slr l sh v e, PreferredWorkIndex l sh i)+    => Threads                -- ^ Number of threads to parallelize walk on+    -> StatefulWalk i e s     -- ^ Stateful slice-wise walking function+    -> IO s                   -- ^ Monadic zero state.+                              -- Wrap pure state in 'return'.+    -> (s -> s -> IO s)       -- ^ Associative monadic state joining function+    -> UArray r l sh (v e)    -- ^ Source array of vectors+    -> IO (VecList (Dim v) s) -- ^ Vector of gathered per slice results+{-# INLINE walkSlicesSeparateP #-}+walkSlicesSeparateP = anyWalkSlicesSeparateP++-- | /O(n)/ Run associative indexed stateful walk+-- over slices of array of vectors, in parallel.+iwalkSlicesSeparateP+    :: UVecSource r slr l sh v e+    => Threads                -- ^ Number of threads to parallelize walk on+    -> StatefulWalk sh e s    -- ^ Stateful slice-wise walking function+    -> IO s                   -- ^ Monadic zero state.+                              -- Wrap pure state in 'return'.+    -> (s -> s -> IO s)       -- ^ Associative monadic state joining function+    -> UArray r l sh (v e)    -- ^ Source array of vectors+    -> IO (VecList (Dim v) s) -- ^ Vector of gathered per slice results+{-# INLINE iwalkSlicesSeparateP #-}+iwalkSlicesSeparateP = anyWalkSlicesSeparateP++-- | /O(n)/ Run associative stateful walk in specified range,+-- over slices of array of vectors, in parallel.+rangeWalkSlicesSeparateP+    :: UVecSource r slr l sh v e+    => Threads                -- ^ Number of threads to parallelize walk on+    -> StatefulWalk sh e s    -- ^ Stateful slice-wise walking function+    -> IO s                   -- ^ Monadic zero state.+                              -- Wrap pure state in 'return'.+    -> (s -> s -> IO s)       -- ^ Associative monadic state joining function+    -> UArray r l sh (v e)    -- ^ Source array of vectors+    -> sh                     -- ^ Top-left+    -> sh                     -- ^ and bottom-right corners of range to walk in+    -> IO (VecList (Dim v) s) -- ^ Vector of gathered per slice results+{-# INLINE rangeWalkSlicesSeparateP #-}+rangeWalkSlicesSeparateP = anyRangeWalkSlicesSeparateP
+ Data/Yarr/Walk/Internal.hs view
@@ -0,0 +1,135 @@++module Data.Yarr.Walk.Internal where++import Prelude as P+import Control.Monad as M+import Data.List (groupBy)+import Data.Function (on)++import Data.Yarr.Base+import Data.Yarr.Shape as S+import Data.Yarr.Eval++import Data.Yarr.Utils.FixedVector as V hiding (toList)+import Data.Yarr.Utils.Fork+import Data.Yarr.Utils.Parallel+++anyWalk+    :: (USource r l sh a, WorkIndex sh i)+    => StatefulWalk i a s+    -> IO s+    -> UArray r l sh a+    -> IO s+{-# INLINE anyWalk #-}+anyWalk fold mz arr = anyRangeWalk fold mz arr zero (gsize arr)++anyRangeWalk+    :: (USource r l sh a, WorkIndex sh i)+    => StatefulWalk i a s+    -> IO s+    -> UArray r l sh a+    -> i -> i+    -> IO s+{-# INLINE anyRangeWalk #-}+anyRangeWalk fold mz arr start end = do+    force arr+    res <- fold mz (gindex arr) start end+    touchArray arr+    return res+++anyWalkP+    :: (USource r l sh a, WorkIndex sh i)+    => Threads+    -> StatefulWalk i a s+    -> IO s+    -> (s -> s -> IO s)+    -> UArray r l sh a+    -> IO s+{-# INLINE anyWalkP #-}+anyWalkP threads fold mz join arr =+    anyRangeWalkP threads fold mz join arr zero (gsize arr)++anyRangeWalkP+    :: (USource r l sh a, WorkIndex sh i)+    => Threads+    -> StatefulWalk i a s+    -> IO s+    -> (s -> s -> IO s)+    -> UArray r l sh a+    -> i -> i+    -> IO s+{-# INLINE anyRangeWalkP #-}+anyRangeWalkP threads fold mz join arr start end = do+    force arr+    ts <- threads+    (r:rs) <- parallel ts $+                makeFork ts start end (fold mz (gindex arr))+    touchArray arr++    M.foldM join r rs+++anyWalkSlicesSeparate+    :: (UVecSource r slr l sh v e, WorkIndex sh i)+    => StatefulWalk i e s+    -> IO s+    -> UArray r l sh (v e)+    -> IO (VecList (Dim v) s)+{-# INLINE anyWalkSlicesSeparate #-}+anyWalkSlicesSeparate fold mz arr =+    anyRangeWalkSlicesSeparate fold mz arr zero (gsize arr)++anyRangeWalkSlicesSeparate+    :: (UVecSource r slr l sh v e, WorkIndex sh i)+    => StatefulWalk i e s+    -> IO s+    -> UArray r l sh (v e)+    -> i -> i+    -> IO (VecList (Dim v) s)+{-# INLINE anyRangeWalkSlicesSeparate #-}+anyRangeWalkSlicesSeparate fold mz arr start end = do+    force arr+    rs <- V.mapM (\sl -> anyRangeWalk fold mz sl start end) (slices arr)+    touchArray arr+    return rs++anyWalkSlicesSeparateP+    :: (UVecSource r slr l sh v e, WorkIndex sh i)+    => Threads+    -> StatefulWalk i e s+    -> IO s+    -> (s -> s -> IO s)+    -> UArray r l sh (v e)+    -> IO (VecList (Dim v) s)+{-# INLINE anyWalkSlicesSeparateP #-}+anyWalkSlicesSeparateP threads fold mz join arr =+    anyRangeWalkSlicesSeparateP threads fold mz join arr zero (gsize arr)++anyRangeWalkSlicesSeparateP+    :: (UVecSource r slr l sh v e, WorkIndex sh i)+    => Threads+    -> StatefulWalk i e s+    -> IO s+    -> (s -> s -> IO s)+    -> UArray r l sh (v e)+    -> i -> i+    -> IO (VecList (Dim v) s)+{-# INLINE anyRangeWalkSlicesSeparateP #-}+anyRangeWalkSlicesSeparateP threads fold mz join arr start end = do+    force arr+    let sls = slices arr+    V.mapM force sls++    ts <- threads+    trs <- parallel ts $+            makeForkSlicesOnce+                ts+                (V.replicate (start, end))+                (V.map (\sl -> fold mz (gindex sl)) sls)+    touchArray arr++    let rsBySlices = P.map (P.map snd) $ groupBy ((==) `on` fst) $ concat trs+    rs <- M.mapM (\(r:rs) -> M.foldM join r rs) rsBySlices+    return (VecList rs)
− Data/Yarr/Work.hs 
@@ -1,270 +0,0 @@--module Data.Yarr.Work (-    -- * Fold combinators-    -- | See source of these 4 functions-    -- to construct more similar ones,-    -- if you need.-    reduceL, reduceLeftM,-    reduceR, reduceRightM,--    -- * Combinators to work with mutable state-    -- | Added specially to improve performance-    -- of tasks like histogram filling.-    ---    -- Unfortunately, GHC doesn't figure that folding state-    -- isn't changed as ADT in such cases and doesn't lift-    -- it's evaluation higher from folding routine.-    mutate, imutate,--    -- * Work runners-    work, iwork, rangeWork,-    workP, iworkP, rangeWorkP,-    workOnSlicesSeparate, iworkOnSlicesSeparate, rangeWorkOnSlicesSeparate,-    workOnSlicesSeparateP, iworkOnSlicesSeparateP, rangeWorkOnSlicesSeparateP,--    -- * Aliases for work types-    StatefulWork, Foldl, Foldr,-) where--import Data.Yarr.Base-import Data.Yarr.Shape as S-import Data.Yarr.Eval--import Data.Yarr.Work.Internal----- | /O(0)/-reduceLeftM-    :: Foldl i a b        -- ^ 'S.foldl' or curried 'S.unrolledFoldl'-    -> (b -> a -> IO b)   -- ^ Monadic left reduce-    -> StatefulWork i a b -- ^ Result stateful work to be passed-                          -- to work runners-{-# INLINE reduceLeftM #-}-reduceLeftM foldl rf = foldl (\b _ a -> rf b a)---- | /O(0)/-reduceL-    :: Foldl i a b        -- ^ 'S.foldl' or curried 'S.unrolledFoldl'-    -> (b -> a -> b)      -- ^ Pure left reduce-    -> StatefulWork i a b -- ^ Result stateful work to be passed-                          -- to work runners-{-# INLINE reduceL #-}-reduceL foldl rf = foldl (\b _ a -> return $ rf b a)---- | /O(0)/-reduceRightM-    :: Foldr i a b         -- ^ 'S.foldr' or curried 'S.unrolledFoldr'-    -> (a -> b -> IO b)    -- ^ Monadic right reduce-    -> StatefulWork i a b  -- ^ Result stateful work to be passed-                           -- to work runners-{-# INLINE reduceRightM #-}-reduceRightM foldr rf = foldr (\_ a b -> rf a b)---- | /O(0)/-reduceR-    :: Foldr i a b        -- ^ 'S.foldr' or curried 'S.unrolledFoldr'-    -> (a -> b -> b)      -- ^ Pure right reduce-    -> StatefulWork i a b -- ^ Result stateful work to be passed-                          -- to work runners-{-# INLINE reduceR #-}-reduceR foldr rf = foldr (\_ a b -> return $ rf a b)----- | /O(0)/-mutate-    :: Fill i a           -- ^ 'S.fill' or curried 'S.unrolledFill'.-                          -- If mutating is associative,-                          -- 'S.dim2BlockFill' is also acceptable.-    -> (s -> a -> IO ())  -- ^ (state -> array element -> (state has changed))-                          -- -- State mutating function-    -> StatefulWork i a s -- ^ Result stateful work to be passed-                          -- to work runners-{-# INLINE mutate #-}-mutate fill mf = imutate fill (\s i -> mf s)---- | /O(0)/ Version of 'mutate', accepts mutating function--- which additionaly accepts array index.-imutate-    :: Fill i a               -- ^ 'S.fill' or curried 'S.unrolledFill'.-                              -- If mutating is associative,-                              -- 'S.dim2BlockFill' is also acceptable.-    -> (s -> i -> a -> IO ()) -- ^ Indexed state mutating function-    -> StatefulWork i a s     -- ^ Result stateful work to be passed-                              -- to work runners-{-# INLINE imutate #-}-imutate fill imf ms index start end = do-    s <- ms-    fill index (imf s) start end-    return s------ | /O(n)/ Run non-indexed stateful work.------ Example:------ @'Data.Yarr.IO.List.toList' = work ('reduceR' 'S.foldr' (:)) (return [])@-work-    :: (USource r l sh a, PreferredWorkIndex l sh i)-    => StatefulWork i a s -- ^ Stateful working function-    -> IO s               -- ^ Monadic initial state (fold zero).-                          -- Wrap pure state in 'return'.-    -> UArray r l sh a    -- ^ Source array-    -> IO s               -- ^ Final state (fold result)-{-# INLINE work #-}-work = anyWork---- | /O(n)/ Run indexed stateful work.------ Example:------ @res \<- iwork ('S.foldl' (\\s i a -> ...)) foldZero sourceArray@-iwork-    :: USource r l sh a-    => StatefulWork sh a s -- ^ Stateful working function-    -> IO s                -- ^ Monadic initial state (fold zero).-                           -- Wrap pure state in 'return'.-    -> UArray r l sh a     -- ^ Source array-    -> IO s                -- ^ Final state (fold result)-{-# INLINE iwork #-}-iwork = anyWork---- | /O(n)/ Run stateful work in specified range of indices.-rangeWork-    :: USource r l sh a-    => StatefulWork sh a s -- ^ Stateful working function-    -> IO s                -- ^ Monadic initial state (fold zero).-                           -- Wrap pure state in 'return'.-    -> UArray r l sh a     -- ^ Source array-    -> sh                  -- ^ Top-left-    -> sh                  -- ^ and bottom-right corners of range to work in-    -> IO s                -- ^ Final state (fold result)-{-# INLINE rangeWork #-}-rangeWork = anyRangeWork----- | /O(n)/ Run associative non-indexed stateful work in parallel.------ Example -- associative image histogram filling in the test:--- <https://github.com/leventov/yarr/blob/master/tests/lum-equalization.hs>-workP-    :: (USource r l sh a, PreferredWorkIndex l sh i)-    => Threads            -- ^ Number of threads to parallelize work on-    -> StatefulWork i a s -- ^ Associative stateful working function-    -> IO s               -- ^ Monadic zero state.-                          -- Wrap pure state in 'return'.-    -> (s -> s -> IO s)   -- ^ Associative monadic state joining function-    -> UArray r l sh a    -- ^ Source array-    -> IO s               -- ^ Gathered state (fold result)-{-# INLINE workP #-}-workP = anyWorkP---- | /O(n)/ Run associative indexed stateful work in parallel.-iworkP-    :: USource r l sh a-    => Threads             -- ^ Number of threads to parallelize work on-    -> StatefulWork sh a s -- ^ Associative stateful working function-    -> IO s                -- ^ Monadic zero state.-                           -- Wrap pure state in 'return'.-    -> (s -> s -> IO s)    -- ^ Associative monadic state joining function-    -> UArray r l sh a     -- ^ Source array-    -> IO s                -- ^ Gathered state (fold result)-{-# INLINE iworkP #-}-iworkP = anyWorkP---- | /O(n)/ Run associative stateful work in specified range in parallel.-rangeWorkP-    :: USource r l sh a-    => Threads             -- ^ Number of threads to parallelize work on-    -> StatefulWork sh a s -- ^ Associative stateful working function-    -> IO s                -- ^ Monadic zero state.-                           -- Wrap pure state in 'return'.-    -> (s -> s -> IO s)    -- ^ Associative monadic state joining function-    -> UArray r l sh a     -- ^ Source array-    -> sh                  -- ^ Top-left-    -> sh                  -- ^ and bottom-right corners of range to work in-    -> IO s                -- ^ Gathered state (fold result)-{-# INLINE rangeWorkP #-}-rangeWorkP = anyRangeWorkP----- | /O(n)/ Run non-indexed stateful work over each slice of array of vectors.-workOnSlicesSeparate-    :: (UVecSource r slr l sh v e, PreferredWorkIndex l sh i)-    => StatefulWork i e s     -- ^ Stateful slice-wise working function-    -> IO s                   -- ^ Monadic initial state (fold zero).-                              -- Wrap pure state in 'return'.-    -> UArray r l sh (v e)    -- ^ Source array of vectors-    -> IO (VecList (Dim v) s) -- ^ Vector of final states (fold results)-{-# INLINE workOnSlicesSeparate #-}-workOnSlicesSeparate = anyWorkOnSlicesSeparate---- | /O(n)/ Run indexed stateful work over each slice of array of vectors.-iworkOnSlicesSeparate-    :: UVecSource r slr l sh v e-    => StatefulWork sh e s    -- ^ Stateful slice-wise working function-    -> IO s                   -- ^ Monadic initial state (fold zero).-                              -- Wrap pure state in 'return'.-    -> UArray r l sh (v e)    -- ^ Source array of vectors-    -> IO (VecList (Dim v) s) -- ^ Vector of final states (fold results)-{-# INLINE iworkOnSlicesSeparate #-}-iworkOnSlicesSeparate = anyWorkOnSlicesSeparate---- | /O(n)/ Run stateful work in specified range--- over each slice of array of vectors.-rangeWorkOnSlicesSeparate-    :: UVecSource r slr l sh v e-    => StatefulWork sh e s    -- ^ Stateful slice-wise working function-    -> IO s                   -- ^ Monadic initial state (fold zero).-                              -- Wrap pure state in 'return'.-    -> UArray r l sh (v e)    -- ^ Source array of vectors-    -> sh                     -- ^ Top-left-    -> sh                     -- ^ and bottom-right corners of range to work in-    -> IO (VecList (Dim v) s) -- ^ Vector of final states (fold results)-{-# INLINE rangeWorkOnSlicesSeparate #-}-rangeWorkOnSlicesSeparate = anyRangeWorkOnSlicesSeparate----- | /O(n)/ Run associative non-indexed stateful work--- over slices of array of vectors in parallel.-workOnSlicesSeparateP-    :: (UVecSource r slr l sh v e, PreferredWorkIndex l sh i)-    => Threads                -- ^ Number of threads to parallelize work on-    -> StatefulWork i e s     -- ^ Stateful slice-wise working function-    -> IO s                   -- ^ Monadic zero state.-                              -- Wrap pure state in 'return'.-    -> (s -> s -> IO s)       -- ^ Associative monadic state joining function-    -> UArray r l sh (v e)    -- ^ Source array of vectors-    -> IO (VecList (Dim v) s) -- ^ Vector of gathered per slice results-{-# INLINE workOnSlicesSeparateP #-}-workOnSlicesSeparateP = anyWorkOnSlicesSeparateP---- | /O(n)/ Run associative indexed stateful work--- over slices of array of vectors in parallel.-iworkOnSlicesSeparateP-    :: UVecSource r slr l sh v e-    => Threads                -- ^ Number of threads to parallelize work on-    -> StatefulWork sh e s    -- ^ Stateful slice-wise working function-    -> IO s                   -- ^ Monadic zero state.-                              -- Wrap pure state in 'return'.-    -> (s -> s -> IO s)       -- ^ Associative monadic state joining function-    -> UArray r l sh (v e)    -- ^ Source array of vectors-    -> IO (VecList (Dim v) s) -- ^ Vector of gathered per slice results-{-# INLINE iworkOnSlicesSeparateP #-}-iworkOnSlicesSeparateP = anyWorkOnSlicesSeparateP---- | /O(n)/ Run associative stateful work in specified range--- over slices of array of vectors in parallel.-rangeWorkOnSlicesSeparateP-    :: UVecSource r slr l sh v e-    => Threads                -- ^ Number of threads to parallelize work on-    -> StatefulWork sh e s    -- ^ Stateful slice-wise working function-    -> IO s                   -- ^ Monadic zero state.-                              -- Wrap pure state in 'return'.-    -> (s -> s -> IO s)       -- ^ Associative monadic state joining function-    -> UArray r l sh (v e)    -- ^ Source array of vectors-    -> sh                     -- ^ Top-left-    -> sh                     -- ^ and bottom-right corners of range to work in-    -> IO (VecList (Dim v) s) -- ^ Vector of gathered per slice results-{-# INLINE rangeWorkOnSlicesSeparateP #-}-rangeWorkOnSlicesSeparateP = anyRangeWorkOnSlicesSeparateP
− Data/Yarr/Work/Internal.hs 
@@ -1,135 +0,0 @@--module Data.Yarr.Work.Internal where--import Prelude as P-import Control.Monad as M-import Data.List (groupBy)-import Data.Function (on)--import Data.Yarr.Base-import Data.Yarr.Shape as S-import Data.Yarr.Eval--import Data.Yarr.Utils.FixedVector as V hiding (toList)-import Data.Yarr.Utils.Fork-import Data.Yarr.Utils.Parallel---anyWork-    :: (USource r l sh a, WorkIndex sh i)-    => StatefulWork i a s-    -> IO s-    -> UArray r l sh a-    -> IO s-{-# INLINE anyWork #-}-anyWork fold mz arr = anyRangeWork fold mz arr zero (gsize arr)--anyRangeWork-    :: (USource r l sh a, WorkIndex sh i)-    => StatefulWork i a s-    -> IO s-    -> UArray r l sh a-    -> i -> i-    -> IO s-{-# INLINE anyRangeWork #-}-anyRangeWork fold mz arr start end = do-    force arr-    res <- fold mz (gindex arr) start end-    touchArray arr-    return res---anyWorkP-    :: (USource r l sh a, WorkIndex sh i)-    => Threads-    -> StatefulWork i a s-    -> IO s-    -> (s -> s -> IO s)-    -> UArray r l sh a-    -> IO s-{-# INLINE anyWorkP #-}-anyWorkP threads fold mz join arr =-    anyRangeWorkP threads fold mz join arr zero (gsize arr)--anyRangeWorkP-    :: (USource r l sh a, WorkIndex sh i)-    => Threads-    -> StatefulWork i a s-    -> IO s-    -> (s -> s -> IO s)-    -> UArray r l sh a-    -> i -> i-    -> IO s-{-# INLINE anyRangeWorkP #-}-anyRangeWorkP threads fold mz join arr start end = do-    force arr-    ts <- threads-    (r:rs) <- parallel ts $-                makeFork ts start end (fold mz (gindex arr))-    touchArray arr--    M.foldM join r rs---anyWorkOnSlicesSeparate-    :: (UVecSource r slr l sh v e, WorkIndex sh i)-    => StatefulWork i e s-    -> IO s-    -> UArray r l sh (v e)-    -> IO (VecList (Dim v) s)-{-# INLINE anyWorkOnSlicesSeparate #-}-anyWorkOnSlicesSeparate fold mz arr =-    anyRangeWorkOnSlicesSeparate fold mz arr zero (gsize arr)--anyRangeWorkOnSlicesSeparate-    :: (UVecSource r slr l sh v e, WorkIndex sh i)-    => StatefulWork i e s-    -> IO s-    -> UArray r l sh (v e)-    -> i -> i-    -> IO (VecList (Dim v) s)-{-# INLINE anyRangeWorkOnSlicesSeparate #-}-anyRangeWorkOnSlicesSeparate fold mz arr start end = do-    force arr-    rs <- V.mapM (\sl -> anyRangeWork fold mz sl start end) (slices arr)-    touchArray arr-    return rs--anyWorkOnSlicesSeparateP-    :: (UVecSource r slr l sh v e, WorkIndex sh i)-    => Threads-    -> StatefulWork i e s-    -> IO s-    -> (s -> s -> IO s)-    -> UArray r l sh (v e)-    -> IO (VecList (Dim v) s)-{-# INLINE anyWorkOnSlicesSeparateP #-}-anyWorkOnSlicesSeparateP threads fold mz join arr =-    anyRangeWorkOnSlicesSeparateP threads fold mz join arr zero (gsize arr)--anyRangeWorkOnSlicesSeparateP-    :: (UVecSource r slr l sh v e, WorkIndex sh i)-    => Threads-    -> StatefulWork i e s-    -> IO s-    -> (s -> s -> IO s)-    -> UArray r l sh (v e)-    -> i -> i-    -> IO (VecList (Dim v) s)-{-# INLINE anyRangeWorkOnSlicesSeparateP #-}-anyRangeWorkOnSlicesSeparateP threads fold mz join arr start end = do-    force arr-    let sls = slices arr-    V.mapM force sls--    ts <- threads-    trs <- parallel ts $-            makeForkSlicesOnce-                ts-                (V.replicate (start, end))-                (V.map (\sl -> fold mz (gindex sl)) sls)-    touchArray arr--    let rsBySlices = P.map (P.map snd) $ groupBy ((==) `on` fst) $ concat trs-    rs <- M.mapM (\(r:rs) -> M.foldM join r rs) rsBySlices-    return (VecList rs)
Data/Yarr/WorkTypes.hs view
@@ -1,15 +1,21 @@  module Data.Yarr.WorkTypes where --- | Generalizes interval works: 'Fill's, 'StatefulWork's.+-- | Abstracts interval works: 'Fill's, 'Walk's. -- -- To be passed to functions from "Data.Yarr.Utils.Fork" module--- and called directly.+-- or called directly. type Work sh a =-       sh   -- ^ Start (lower index)-    -> sh   -- ^ End (higher index)+       sh   -- ^ Lower bound+    -> sh   -- ^ Upper bound     -> IO a -- ^ Result +-- | Curried version of 'StatefulWalk'. Identical to 'Work', indeed.+type Walk sh a =+       sh   -- ^ Lower bound (start for left walks, end for right ones)+    -> sh   -- ^ Upper bound (end or start)+    -> IO a -- ^ Result+ -- | Alias to frequently used get-write-from-to arguments combo. -- -- To be passed as 1st parameter of all 'Data.Yarr.Eval.Load'ing functions@@ -21,25 +27,25 @@   -- | Generalizes both partially applied left and right folds,--- as well as works on mutable state.+-- as well as walks with mutable state. ----- To be passed to fold runners from "Data.Yarr.Work" module.-type StatefulWork sh a s = +-- To be passed to walk runners from "Data.Yarr.Walk" module.+type StatefulWalk sh a s =         IO s         -- ^ Initial state     -> (sh -> IO a) -- ^ Indexing function-    -> Work sh s    -- ^ Curried result function -- worker,+    -> Walk sh s    -- ^ Curried result function -- walker,                     -- emits final state --- | Generalizes left to right folds.+-- | Generalizes left folds. ----- To be passed to fold combinators from "Data.Yarr.Work" module.+-- To be passed to fold combinators from "Data.Yarr.Walk" module. type Foldl sh a b =        (b -> sh -> a -> IO b) -- ^ Generalized left reduce-    -> StatefulWork sh a b    -- ^ Curried result stateful work+    -> StatefulWalk sh a b    -- ^ Curried result stateful walk --- | Generalizes right to left folds.+-- | Generalizes right folds. ----- To be passed to fold combinators from "Data.Yarr.Work" module.+-- To be passed to fold combinators from "Data.Yarr.Walk" module. type Foldr sh a b =        (sh -> a -> b -> IO b) -- ^ Generalized right reduce-    -> StatefulWork sh a b    -- ^ Curried result stateful work+    -> StatefulWalk sh a b    -- ^ Curried result stateful walk
yarr.cabal view
@@ -1,5 +1,5 @@ Name:                yarr-Version:             1.2.3+Version:             1.3.1 Synopsis:            Yet another array library Description:     Yarr is a new blazing fast dataflow framework (array library),@@ -20,9 +20,15 @@     .     Shortcoming by design: lack of pure indexing interface.     .+    /Changes in 1.3 (ex. 0.9.3):/+    .+        * IFusion -- mapping/zipping with index+    .+        * Rename: Work -> Walk+    .     /Changes in version 0.9.2:/     .-        * Safe folds -- see "Data.Yarr.Work"+        * Safe folds -- see "Data.Yarr.Walk"     .         * Issue with slice-wise loading with unrolled filling function solved     .@@ -58,7 +64,8 @@         TypeFamilies, MultiParamTypeClasses, FunctionalDependencies,         FlexibleContexts,         EmptyDataDecls,-        FlexibleInstances, TypeSynonymInstances, UndecidableInstances,+        FlexibleInstances, TypeSynonymInstances,+        UndecidableInstances, OverlappingInstances,         GeneralizedNewtypeDeriving, StandaloneDeriving,         RankNTypes, ScopedTypeVariables,         MagicHash, BangPatterns, UnboxedTuples,@@ -67,9 +74,10 @@     exposed-modules:         Data.Yarr         Data.Yarr.Base+        Data.Yarr.Fusion         Data.Yarr.Eval         Data.Yarr.Flow-        Data.Yarr.Work+        Data.Yarr.Walk         Data.Yarr.Shape         Data.Yarr.Repr.Foreign         Data.Yarr.Repr.Boxed@@ -82,7 +90,6 @@         Data.Yarr.Utils.Parallel         Data.Yarr.Utils.Split         Data.Yarr.Utils.Primitive-        Data.Yarr.Utils.LowLevelFlow         Debug.Yarr      other-modules:@@ -101,5 +108,6 @@         -- re-exported in Data.Yarr.Shape         Data.Yarr.WorkTypes -        Data.Yarr.Work.Internal+        Data.Yarr.Walk.Internal         Data.Yarr.Utils.Storable+        Data.Yarr.Utils.LowLevelFlow