1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
module Data.Array.Repa.Repr.ForeignPtr
( F, Array (..)
, fromForeignPtr, toForeignPtr
, computeIntoS, computeIntoP)
where
import Data.Array.Repa.Shape
import Data.Array.Repa.Base
import Data.Array.Repa.Eval.Load
import Data.Array.Repa.Eval.Target
import Data.Array.Repa.Repr.Delayed
import Foreign.Storable
import Foreign.ForeignPtr
import Foreign.Marshal.Alloc
import System.IO.Unsafe
import qualified Foreign.ForeignPtr.Unsafe as Unsafe
-- | Arrays represented as foreign buffers in the C heap.
data F
-- | Read elements from a foreign buffer.
instance Storable a => Source F a where
data Array F sh a
= AForeignPtr !sh !Int !(ForeignPtr a)
linearIndex (AForeignPtr _ len fptr) ix
| ix < len
= unsafePerformIO
$ withForeignPtr fptr
$ \ptr -> peekElemOff ptr ix
| otherwise
= error "Repa: foreign array index out of bounds"
{-# INLINE linearIndex #-}
unsafeLinearIndex (AForeignPtr _ _ fptr) ix
= unsafePerformIO
$ withForeignPtr fptr
$ \ptr -> peekElemOff ptr ix
{-# INLINE unsafeLinearIndex #-}
extent (AForeignPtr sh _ _)
= sh
{-# INLINE extent #-}
deepSeqArray (AForeignPtr sh len fptr) x
= sh `deepSeq` len `seq` fptr `seq` x
{-# INLINE deepSeqArray #-}
-- Load -----------------------------------------------------------------------
-- | Filling foreign buffers.
instance Storable e => Target F e where
data MVec F e
= FPVec !Int !(ForeignPtr e)
newMVec n
= do let (proxy :: e) = undefined
ptr <- mallocBytes (sizeOf proxy * n)
_ <- peek ptr `asTypeOf` return proxy
fptr <- newForeignPtr finalizerFree ptr
return $ FPVec n fptr
{-# INLINE newMVec #-}
-- CAREFUL: Unwrapping the foreignPtr like this means we need to be careful
-- to touch it after the last use, otherwise the finaliser might run too early.
unsafeWriteMVec (FPVec _ fptr) !ix !x
= pokeElemOff (Unsafe.unsafeForeignPtrToPtr fptr) ix x
{-# INLINE unsafeWriteMVec #-}
unsafeFreezeMVec !sh (FPVec len fptr)
= return $ AForeignPtr sh len fptr
{-# INLINE unsafeFreezeMVec #-}
deepSeqMVec !(FPVec _ fptr) x
= Unsafe.unsafeForeignPtrToPtr fptr `seq` x
{-# INLINE deepSeqMVec #-}
touchMVec (FPVec _ fptr)
= touchForeignPtr fptr
{-# INLINE touchMVec #-}
-- Conversions ----------------------------------------------------------------
-- | O(1). Wrap a `ForeignPtr` as an array.
fromForeignPtr
:: Shape sh
=> sh -> ForeignPtr e -> Array F sh e
fromForeignPtr !sh !fptr
= AForeignPtr sh (size sh) fptr
{-# INLINE fromForeignPtr #-}
-- | O(1). Unpack a `ForeignPtr` from an array.
toForeignPtr :: Array F sh e -> ForeignPtr e
toForeignPtr (AForeignPtr _ _ fptr)
= fptr
{-# INLINE toForeignPtr #-}
-- | Compute an array sequentially and write the elements into a foreign
-- buffer without intermediate copying. If you want to copy a
-- pre-existing manifest array to a foreign buffer then `delay` it first.
computeIntoS
:: (Load r1 sh e, Storable e)
=> ForeignPtr e -> Array r1 sh e -> IO ()
computeIntoS !fptr !arr
= loadS arr (FPVec 0 fptr)
{-# INLINE computeIntoS #-}
-- | Compute an array in parallel and write the elements into a foreign
-- buffer without intermediate copying. If you want to copy a
-- pre-existing manifest array to a foreign buffer then `delay` it first.
computeIntoP
:: (Load r1 sh e, Storable e)
=> ForeignPtr e -> Array r1 sh e -> IO ()
computeIntoP !fptr !arr
= loadP arr (FPVec 0 fptr)
{-# INLINE computeIntoP #-}
|
