diff --git a/Data/Array/Repa.hs b/Data/Array/Repa.hs --- a/Data/Array/Repa.hs +++ b/Data/Array/Repa.hs @@ -9,6 +9,12 @@ -- There is a draft tutorial at -- -- @Release Notes: +-- For 2.2.0.1: +-- * Added unsafeFromForeignPtr, which helps use foreign source +-- arrays without intermediate copying. +-- * Added forceWith and forceWith2, which can be used to force +-- arrays into foreign result buffers without intermediate copying. +-- -- For 2.1.0.1: -- * The fold and foldAll functions now run in parallel and require the -- starting element to be neutral with respect to the reduction operator. @@ -46,10 +52,12 @@ , fromFunction , fromVector , fromList + , unsafeFromForeignPtr -- from Data.Array.Repa.Interlals.Forcing ------------------- -- * Forcing - , force, force2 + , force, forceWith + , force2, forceWith2 , toVector , toList diff --git a/Data/Array/Repa/Internals/Base.hs b/Data/Array/Repa/Internals/Base.hs --- a/Data/Array/Repa/Internals/Base.hs +++ b/Data/Array/Repa/Internals/Base.hs @@ -22,13 +22,17 @@ -- * Construction , fromFunction , fromVector - , fromList) + , fromList + , unsafeFromForeignPtr) where import Data.Array.Repa.Index import Data.Array.Repa.Internals.Elt import Data.Array.Repa.Shape as S import qualified Data.Vector.Unboxed as V import Data.Vector.Unboxed (Vector) +import Foreign.ForeignPtr +import Foreign.Storable +import System.IO.Unsafe stage = "Data.Array.Repa.Array" @@ -366,7 +370,6 @@ Array sh [Region RangeAll (GenManifest vec)] --- Conversion ------------------------------------------------------------------------------------- -- | Convert a list to an array. -- The length of the list must be exactly the `size` of the extent given, else `error`. fromList @@ -387,4 +390,21 @@ = Array sh [Region RangeAll (GenManifest vec)] where vec = V.fromList xx + + +-- | Convert a `Ptr` to an `Array`. +-- The data is used directly, and not copied. +-- You promise not to modify the pointed-to data any further. +-- +unsafeFromForeignPtr + :: (Shape sh, Elt a, Storable a) + => sh + -> ForeignPtr a + -> Array sh a + +unsafeFromForeignPtr sh fptr + = fromFunction sh + (\ix -> unsafePerformIO + $ withForeignPtr fptr + (\ptr -> peekElemOff ptr $ toIndex sh ix)) diff --git a/Data/Array/Repa/Internals/EvalBlockwise.hs b/Data/Array/Repa/Internals/EvalBlockwise.hs --- a/Data/Array/Repa/Internals/EvalBlockwise.hs +++ b/Data/Array/Repa/Internals/EvalBlockwise.hs @@ -1,4 +1,7 @@ {-# LANGUAGE BangPatterns #-} + +-- | Old non-cursored, blockwise filling functions. +-- NOTE: this isn't currently used. module Data.Array.Repa.Internals.EvalBlockwise ( fillVectorBlockwiseP , fillVectorBlock diff --git a/Data/Array/Repa/Internals/EvalChunked.hs b/Data/Array/Repa/Internals/EvalChunked.hs --- a/Data/Array/Repa/Internals/EvalChunked.hs +++ b/Data/Array/Repa/Internals/EvalChunked.hs @@ -5,42 +5,37 @@ ( fillChunkedS , fillChunkedP) where -import Data.Array.Repa.Internals.Elt import Data.Array.Repa.Internals.Gang -import Data.Vector.Unboxed as V -import Data.Vector.Unboxed.Mutable as VM import GHC.Base (remInt, quotInt) import Prelude as P --- | Fill a vector sequentially. +-- | Fill something sequentially. fillChunkedS - :: Elt a - => IOVector a -- ^ Vector to fill. - -> (Int -> a) -- ^ Fn to get the value at a given index. + :: Int -- ^ Number of elements + -> (Int -> a -> IO ()) -- ^ Update function to write into result buffer + -> (Int -> a) -- ^ Fn to get the value at a given index. -> IO () {-# INLINE [0] fillChunkedS #-} -fillChunkedS !vec !getElem +fillChunkedS !len !write !getElem = fill 0 - where !len = VM.length vec - - fill !ix + where fill !ix | ix >= len = return () | otherwise - = do VM.unsafeWrite vec ix (getElem ix) + = do write ix (getElem ix) fill (ix + 1) --- | Fill a vector in parallel. +-- | Fill something in parallel. fillChunkedP - :: Unbox a - => IOVector a -- ^ Vector to fill. - -> (Int -> a) -- ^ Fn to get the value at a given index. + :: Int -- ^ Number of elements + -> (Int -> a -> IO ()) -- ^ Update function to write into result buffer + -> (Int -> a) -- ^ Fn to get the value at a given index. -> IO () {-# INLINE [0] fillChunkedP #-} -fillChunkedP !vec !getElem +fillChunkedP !len !write !getElem = gangIO theGang $ \thread -> fill (splitIx thread) (splitIx (thread + 1)) @@ -49,7 +44,6 @@ -- If the length of the vector doesn't divide evenly among the threads, -- then the first few get an extra element. !threads = gangSize theGang - !len = VM.length vec !chunkLen = len `quotInt` threads !chunkLeftover = len `remInt` threads @@ -63,6 +57,6 @@ fill !ix !end | ix >= end = return () | otherwise - = do VM.unsafeWrite vec ix (getElem ix) + = do write ix (getElem ix) fill (ix + 1) end diff --git a/Data/Array/Repa/Internals/EvalCursored.hs b/Data/Array/Repa/Internals/EvalCursored.hs --- a/Data/Array/Repa/Internals/EvalCursored.hs +++ b/Data/Array/Repa/Internals/EvalCursored.hs @@ -7,7 +7,6 @@ import Data.Array.Repa.Index import Data.Array.Repa.Internals.Elt import Data.Array.Repa.Internals.Gang -import Data.Vector.Unboxed.Mutable as VM import GHC.Base (remInt, quotInt) import Prelude as P @@ -18,7 +17,7 @@ -- We divide the block into columns, and give one column to each thread. fillCursoredBlock2P :: Elt a - => IOVector a -- ^ vector to write elements into + => (Int -> a -> IO ()) -- ^ Update function to write into result buffer -> (DIM2 -> cursor) -- ^ make a cursor to a particular element -> (DIM2 -> cursor -> cursor) -- ^ shift the cursor by an offset -> (cursor -> a) -- ^ fn to evaluate an element at the given index. @@ -31,7 +30,7 @@ {-# INLINE [0] fillCursoredBlock2P #-} fillCursoredBlock2P - !vec + !write !makeCursorFCB !shiftCursorFCB !getElemFCB !imageWidth !x0 !y0 !x1 !y1 = gangIO theGang fillBlock @@ -59,7 +58,7 @@ !y0' = y0 !y1' = y1 in fillCursoredBlock2 - vec + write makeCursorFCB shiftCursorFCB getElemFCB imageWidth x0' y0' x1' y1' @@ -68,7 +67,7 @@ -- Coordinates given are of the filled edges of the block. fillCursoredBlock2 :: Elt a - => IOVector a -- ^ vector to write elements into. + => (Int -> a -> IO ()) -- ^ Update function to write into result buffer -> (DIM2 -> cursor) -- ^ make a cursor to a particular element -> (DIM2 -> cursor -> cursor) -- ^ shift the cursor by an offset -> (cursor -> a) -- ^ fn to evaluate an element at the given index. @@ -81,7 +80,7 @@ {-# INLINE [0] fillCursoredBlock2 #-} fillCursoredBlock2 - !vec + !write !makeCursor !shiftCursor !getElem !imageWidth !x0 !y0 !x1 !y1 @@ -122,16 +121,16 @@ -- Compute cursor into destination array. let !dstCur0 = x + y * imageWidth - VM.unsafeWrite vec (dstCur0) val0 - VM.unsafeWrite vec (dstCur0 + 1) val1 - VM.unsafeWrite vec (dstCur0 + 2) val2 - VM.unsafeWrite vec (dstCur0 + 3) val3 + write (dstCur0) val0 + write (dstCur0 + 1) val1 + write (dstCur0 + 2) val2 + write (dstCur0 + 3) val3 fillLine4 (x + 4) {-# INLINE fillLine1 #-} fillLine1 !x | x > x1 = return () | otherwise - = do VM.unsafeWrite vec (x + y * imageWidth) (getElem $ makeCursor (Z :. y :. x)) + = do write (x + y * imageWidth) (getElem $ makeCursor (Z :. y :. x)) fillLine1 (x + 1) diff --git a/Data/Array/Repa/Internals/Forcing.hs b/Data/Array/Repa/Internals/Forcing.hs --- a/Data/Array/Repa/Internals/Forcing.hs +++ b/Data/Array/Repa/Internals/Forcing.hs @@ -2,7 +2,8 @@ module Data.Array.Repa.Internals.Forcing ( toVector , toList - , force, force2) + , force, forceWith + , force2, forceWith2) where import Data.Array.Repa.Internals.EvalChunked import Data.Array.Repa.Internals.EvalCursored @@ -63,11 +64,28 @@ Array sh _ -> do mvec <- VM.unsafeNew (S.size sh) - fillChunkedP mvec (\ix -> arr' `unsafeIndex` fromIndex sh ix) + forceWith (VM.unsafeWrite mvec) arr' vec <- V.unsafeFreeze mvec return (sh, vec) +-- | Force an array, passing elements to the provided update function. +-- Provide something like @(Foreign.Ptr.pokeElemOff ptr)@ to write elements into a buffer. +-- The array is split into linear chunks and each chunk is evaluated in parallel. +forceWith + :: (Shape sh, Elt a) + => (Int -> a -> IO ()) + -> Array sh a + -> IO () + +{-# INLINE [2] forceWith #-} +forceWith !update arr@(Array sh _) + = fillChunkedP + (S.size sh) + update + (\ix -> arr `unsafeIndex` fromIndex sh ix) + + -- | Force an array, so that it becomes `Manifest`. -- This forcing function is specialised for DIM2 arrays, and does blockwise filling. force2 :: Elt a => Array DIM2 a -> Array DIM2 a @@ -86,30 +104,46 @@ -> return (sh, vec) -- Create a vector to hold the new array and load in the regions. - -- NOTE We must specialise this for the common case of two regions to enable - -- fusion for them. If we just have the next case (arbitrary region list) - -- the worker won't fuse with the filling / evaluation code. - Array sh [r1] + Array sh _ -> do mvec <- VM.new (S.size sh) - fillRegion2P mvec sh r1 - vec <- V.unsafeFreeze mvec - return (sh, vec) + forceWith2 (VM.unsafeWrite mvec) arr' + vec <- V.unsafeFreeze mvec + return (sh, vec) - Array sh [r1, r2] - -> do mvec <- VM.new (S.size sh) - fillRegion2P mvec sh r1 - fillRegion2P mvec sh r2 - vec <- V.unsafeFreeze mvec - return (sh, vec) - -- Create a vector to hold the new array and load in the regions. - Array sh regions - -> do mvec <- VM.new (S.size sh) - mapM_ (fillRegion2P mvec sh) regions - vec <- V.unsafeFreeze mvec - return (sh, vec) +-- | Force an array, passing elements to the provided update function. +-- Provide something like @(Foreign.Ptr.pokeElemOff ptr)@ to write elements into a buffer. +-- This forcing function is specialised for DIM2 arrays, and does blockwise filling. +forceWith2 + :: Elt a + => (Int -> a -> IO ()) + -> Array DIM2 a + -> IO () +{-# INLINE [2] forceWith2 #-} +forceWith2 !write arr + = arr `deepSeqArray` + case arr of + -- If the array is already manifest then copy it into the buffer. + -- We don't need a particular traversal order just for a copy. + Array _ [Region RangeAll (GenManifest _)] + -> forceWith write arr + -- NOTE We must specialise this for common numbers of regions so that + -- we get fusion for them. If we just have the last case (arbitrary + -- region list) then the worker won't fuse with the filling / + -- evaluation code. + Array sh [r1] + -> do fillRegion2P write sh r1 + + Array sh [r1, r2] + -> do fillRegion2P write sh r1 + fillRegion2P write sh r2 + + Array sh regions + -> do mapM_ (fillRegion2P write sh) regions + + -- FillRegion2P ----------------------------------------------------------------------------------- -- | Fill an array region into a vector. -- This is specialised for DIM2 regions. @@ -120,54 +154,62 @@ -- fillRegion2P :: Elt a - => VM.IOVector a -- ^ Vector to write elements into. + => (Int -> a -> IO ()) -- ^ Update function to write into result buffer -> DIM2 -- ^ Extent of entire array. -> Region DIM2 a -- ^ Region to fill. -> IO () {-# INLINE [1] fillRegion2P #-} -fillRegion2P mvec sh@(_ :. height :. width) (Region range gen) - = mvec `seq` height `seq` width `seq` +fillRegion2P write sh@(_ :. height :. width) (Region range gen) + = write `seq` height `seq` width `seq` case range of RangeAll - -> fillRect2 mvec sh gen + -> fillRect2 write sh gen (Rect (Z :. 0 :. 0) (Z :. height - 1 :. width - 1)) - RangeRects _ [rect] - -> fillRect2 mvec sh gen rect + RangeRects _ [r1] + -> do fillRect2 write sh gen r1 - -- Specialise for the common case of 4 rectangles so we get fusion. - -- The following case with mapM_ doesn't fuse because mapM_ isn't completely unrolled. + RangeRects _ [r1, r2] + -> do fillRect2 write sh gen r1 + fillRect2 write sh gen r2 + + RangeRects _ [r1, r2, r3] + -> do fillRect2 write sh gen r1 + fillRect2 write sh gen r2 + fillRect2 write sh gen r3 + RangeRects _ [r1, r2, r3, r4] - -> do fillRect2 mvec sh gen r1 - fillRect2 mvec sh gen r2 - fillRect2 mvec sh gen r3 - fillRect2 mvec sh gen r4 + -> do fillRect2 write sh gen r1 + fillRect2 write sh gen r2 + fillRect2 write sh gen r3 + fillRect2 write sh gen r4 RangeRects _ rects - -> mapM_ (fillRect2 mvec sh gen) rects + -> mapM_ (fillRect2 write sh gen) rects -- | Fill a rectangle in a vector. fillRect2 :: Elt a - => VM.IOVector a -- ^ Vector to write elements into. + => (Int -> a -> IO ()) -- ^ Update function to write into result buffer -> DIM2 -- ^ Extent of entire array. -> Generator DIM2 a -- ^ Generator for array elements. -> Rect DIM2 -- ^ Rectangle to fill. -> IO () {-# INLINE fillRect2 #-} -fillRect2 mvec (_ :. _ :. width) gen (Rect (Z :. y0 :. x0) (Z :. y1 :. x1)) - = mvec `seq` width `seq` y0 `seq` x0 `seq` y1 `seq` x1 `seq` +fillRect2 write sh@(_ :. _ :. width) gen (Rect (Z :. y0 :. x0) (Z :. y1 :. x1)) + = write `seq` width `seq` y0 `seq` x0 `seq` y1 `seq` x1 `seq` case gen of - GenManifest{} - -> error "fillRegion2P: GenManifest, copy elements." + GenManifest vec + -> fillCursoredBlock2P write + id addDim (\ix -> vec `V.unsafeIndex` toIndex sh ix) + width x0 y0 x1 y1 -- Cursor based arrays. GenCursor makeCursor shiftCursor loadElem - -> fillCursoredBlock2P mvec + -> fillCursoredBlock2P write makeCursor shiftCursor loadElem width x0 y0 x1 y1 - diff --git a/Data/Array/Repa/Internals/Gang.hs b/Data/Array/Repa/Internals/Gang.hs --- a/Data/Array/Repa/Internals/Gang.hs +++ b/Data/Array/Repa/Internals/Gang.hs @@ -13,7 +13,7 @@ where import GHC.IO import GHC.ST -import GHC.Conc (forkOnIO) +import GHC.Conc (forkOn) import Control.Concurrent.MVar import Control.Exception (assert) @@ -141,7 +141,7 @@ mapM_ (\var -> addMVarFinalizer var (finaliseWorker var)) mvs -- Create all the worker threads - zipWithM_ forkOnIO [0..] + zipWithM_ forkOn [0..] $ zipWith gangWorker [0 .. n-1] mvs -- The gang is currently idle. diff --git a/repa.cabal b/repa.cabal --- a/repa.cabal +++ b/repa.cabal @@ -1,5 +1,5 @@ Name: repa -Version: 2.1.1.6 +Version: 2.2.0.1 License: BSD3 License-file: LICENSE Author: The DPH Team @@ -25,7 +25,7 @@ Build-Depends: base == 4.4.*, ghc-prim == 0.2.*, - vector >= 0.7 && < 0.8, + vector == 0.9.*, QuickCheck >= 2.3 && < 2.5, template-haskell >= 2.5 && < 2.7