Use explicit language extensions & remove extension fields from base.cabal
[ghc-base.git] / Foreign / Marshal / Array.hs
1 {-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-}
2
3 -----------------------------------------------------------------------------
4 -- |
5 -- Module      :  Foreign.Marshal.Array
6 -- Copyright   :  (c) The FFI task force 2001
7 -- License     :  BSD-style (see the file libraries/base/LICENSE)
8 -- 
9 -- Maintainer  :  ffi@haskell.org
10 -- Stability   :  provisional
11 -- Portability :  portable
12 --
13 -- Marshalling support: routines allocating, storing, and retrieving Haskell
14 -- lists that are represented as arrays in the foreign language
15 --
16 -----------------------------------------------------------------------------
17
18 module Foreign.Marshal.Array (
19   -- * Marshalling arrays
20
21   -- ** Allocation
22   --
23   mallocArray,    -- :: Storable a => Int -> IO (Ptr a)
24   mallocArray0,   -- :: Storable a => Int -> IO (Ptr a)
25
26   allocaArray,    -- :: Storable a => Int -> (Ptr a -> IO b) -> IO b
27   allocaArray0,   -- :: Storable a => Int -> (Ptr a -> IO b) -> IO b
28
29   reallocArray,   -- :: Storable a => Ptr a -> Int -> IO (Ptr a)
30   reallocArray0,  -- :: Storable a => Ptr a -> Int -> IO (Ptr a)
31
32   -- ** Marshalling
33   --
34   peekArray,      -- :: Storable a =>         Int -> Ptr a -> IO [a]
35   peekArray0,     -- :: (Storable a, Eq a) => a   -> Ptr a -> IO [a]
36
37   pokeArray,      -- :: Storable a =>      Ptr a -> [a] -> IO ()
38   pokeArray0,     -- :: Storable a => a -> Ptr a -> [a] -> IO ()
39
40   -- ** Combined allocation and marshalling
41   --
42   newArray,       -- :: Storable a =>      [a] -> IO (Ptr a)
43   newArray0,      -- :: Storable a => a -> [a] -> IO (Ptr a)
44
45   withArray,      -- :: Storable a =>      [a] -> (Ptr a -> IO b) -> IO b
46   withArray0,     -- :: Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b
47
48   withArrayLen,   -- :: Storable a =>      [a] -> (Int -> Ptr a -> IO b) -> IO b
49   withArrayLen0,  -- :: Storable a => a -> [a] -> (Int -> Ptr a -> IO b) -> IO b
50
51   -- ** Copying
52
53   -- | (argument order: destination, source)
54   copyArray,      -- :: Storable a => Ptr a -> Ptr a -> Int -> IO ()
55   moveArray,      -- :: Storable a => Ptr a -> Ptr a -> Int -> IO ()
56
57   -- ** Finding the length
58   --
59   lengthArray0,   -- :: (Storable a, Eq a) => a -> Ptr a -> IO Int
60
61   -- ** Indexing
62   --
63   advancePtr,     -- :: Storable a => Ptr a -> Int -> Ptr a
64 ) where
65
66 import Foreign.Ptr      (Ptr, plusPtr)
67 import Foreign.Storable (Storable(alignment,sizeOf,peekElemOff,pokeElemOff))
68 import Foreign.Marshal.Alloc (mallocBytes, allocaBytesAligned, reallocBytes)
69 import Foreign.Marshal.Utils (copyBytes, moveBytes)
70
71 #ifdef __GLASGOW_HASKELL__
72 import GHC.Num
73 import GHC.List
74 import GHC.Err
75 import GHC.Base
76 #else
77 import Control.Monad (zipWithM_)
78 #endif
79
80 -- allocation
81 -- ----------
82
83 -- |Allocate storage for the given number of elements of a storable type
84 -- (like 'Foreign.Marshal.Alloc.malloc', but for multiple elements).
85 --
86 mallocArray :: Storable a => Int -> IO (Ptr a)
87 mallocArray  = doMalloc undefined
88   where
89     doMalloc            :: Storable a' => a' -> Int -> IO (Ptr a')
90     doMalloc dummy size  = mallocBytes (size * sizeOf dummy)
91
92 -- |Like 'mallocArray', but add an extra position to hold a special
93 -- termination element.
94 --
95 mallocArray0      :: Storable a => Int -> IO (Ptr a)
96 mallocArray0 size  = mallocArray (size + 1)
97
98 -- |Temporarily allocate space for the given number of elements
99 -- (like 'Foreign.Marshal.Alloc.alloca', but for multiple elements).
100 --
101 allocaArray :: Storable a => Int -> (Ptr a -> IO b) -> IO b
102 allocaArray  = doAlloca undefined
103   where
104     doAlloca            :: Storable a' => a' -> Int -> (Ptr a' -> IO b') -> IO b'
105     doAlloca dummy size  = allocaBytesAligned (size * sizeOf dummy)
106                                               (alignment dummy)
107
108 -- |Like 'allocaArray', but add an extra position to hold a special
109 -- termination element.
110 --
111 allocaArray0      :: Storable a => Int -> (Ptr a -> IO b) -> IO b
112 allocaArray0 size  = allocaArray (size + 1)
113 {-# INLINE allocaArray0 #-}
114   -- needed to get allocaArray to inline into withCString, for unknown
115   -- reasons --SDM 23/4/2010, see #4004 for benchmark
116
117 -- |Adjust the size of an array
118 --
119 reallocArray :: Storable a => Ptr a -> Int -> IO (Ptr a)
120 reallocArray  = doRealloc undefined
121   where
122     doRealloc                :: Storable a' => a' -> Ptr a' -> Int -> IO (Ptr a')
123     doRealloc dummy ptr size  = reallocBytes ptr (size * sizeOf dummy)
124
125 -- |Adjust the size of an array including an extra position for the end marker.
126 --
127 reallocArray0          :: Storable a => Ptr a -> Int -> IO (Ptr a)
128 reallocArray0 ptr size  = reallocArray ptr (size + 1)
129
130
131 -- marshalling
132 -- -----------
133
134 -- |Convert an array of given length into a Haskell list.  The implementation
135 -- is tail-recursive and so uses constant stack space.
136 --
137 peekArray          :: Storable a => Int -> Ptr a -> IO [a]
138 peekArray size ptr | size <= 0 = return []
139                  | otherwise = f (size-1) []
140   where
141     f 0 acc = do e <- peekElemOff ptr 0; return (e:acc)
142     f n acc = do e <- peekElemOff ptr n; f (n-1) (e:acc)
143   
144 -- |Convert an array terminated by the given end marker into a Haskell list
145 --
146 peekArray0            :: (Storable a, Eq a) => a -> Ptr a -> IO [a]
147 peekArray0 marker ptr  = do
148   size <- lengthArray0 marker ptr
149   peekArray size ptr
150
151 -- |Write the list elements consecutive into memory
152 --
153 pokeArray :: Storable a => Ptr a -> [a] -> IO ()
154 #ifndef __GLASGOW_HASKELL__
155 pokeArray ptr vals =  zipWithM_ (pokeElemOff ptr) [0..] vals
156 #else
157 pokeArray ptr vals0 = go vals0 0#
158   where go [] _          = return ()
159         go (val:vals) n# = do pokeElemOff ptr (I# n#) val; go vals (n# +# 1#)
160 #endif
161
162 -- |Write the list elements consecutive into memory and terminate them with the
163 -- given marker element
164 --
165 pokeArray0 :: Storable a => a -> Ptr a -> [a] -> IO ()
166 #ifndef __GLASGOW_HASKELL__
167 pokeArray0 marker ptr vals  = do
168   pokeArray ptr vals
169   pokeElemOff ptr (length vals) marker
170 #else
171 pokeArray0 marker ptr vals0 = go vals0 0#
172   where go [] n#         = pokeElemOff ptr (I# n#) marker
173         go (val:vals) n# = do pokeElemOff ptr (I# n#) val; go vals (n# +# 1#)
174 #endif
175
176
177 -- combined allocation and marshalling
178 -- -----------------------------------
179
180 -- |Write a list of storable elements into a newly allocated, consecutive
181 -- sequence of storable values
182 -- (like 'Foreign.Marshal.Utils.new', but for multiple elements).
183 --
184 newArray      :: Storable a => [a] -> IO (Ptr a)
185 newArray vals  = do
186   ptr <- mallocArray (length vals)
187   pokeArray ptr vals
188   return ptr
189
190 -- |Write a list of storable elements into a newly allocated, consecutive
191 -- sequence of storable values, where the end is fixed by the given end marker
192 --
193 newArray0             :: Storable a => a -> [a] -> IO (Ptr a)
194 newArray0 marker vals  = do
195   ptr <- mallocArray0 (length vals)
196   pokeArray0 marker ptr vals
197   return ptr
198
199 -- |Temporarily store a list of storable values in memory
200 -- (like 'Foreign.Marshal.Utils.with', but for multiple elements).
201 --
202 withArray :: Storable a => [a] -> (Ptr a -> IO b) -> IO b
203 withArray vals = withArrayLen vals . const
204
205 -- |Like 'withArray', but the action gets the number of values
206 -- as an additional parameter
207 --
208 withArrayLen :: Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
209 withArrayLen vals f  =
210   allocaArray len $ \ptr -> do
211       pokeArray ptr vals
212       res <- f len ptr
213       return res
214   where
215     len = length vals
216
217 -- |Like 'withArray', but a terminator indicates where the array ends
218 --
219 withArray0 :: Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b
220 withArray0 marker vals = withArrayLen0 marker vals . const
221
222 -- |Like 'withArrayLen', but a terminator indicates where the array ends
223 --
224 withArrayLen0 :: Storable a => a -> [a] -> (Int -> Ptr a -> IO b) -> IO b
225 withArrayLen0 marker vals f  =
226   allocaArray0 len $ \ptr -> do
227       pokeArray0 marker ptr vals
228       res <- f len ptr
229       return res
230   where
231     len = length vals
232
233
234 -- copying (argument order: destination, source)
235 -- -------
236
237 -- |Copy the given number of elements from the second array (source) into the
238 -- first array (destination); the copied areas may /not/ overlap
239 --
240 copyArray :: Storable a => Ptr a -> Ptr a -> Int -> IO ()
241 copyArray  = doCopy undefined
242   where
243     doCopy                     :: Storable a' => a' -> Ptr a' -> Ptr a' -> Int -> IO ()
244     doCopy dummy dest src size  = copyBytes dest src (size * sizeOf dummy)
245
246 -- |Copy the given number of elements from the second array (source) into the
247 -- first array (destination); the copied areas /may/ overlap
248 --
249 moveArray :: Storable a => Ptr a -> Ptr a -> Int -> IO ()
250 moveArray  = doMove undefined
251   where
252     doMove                     :: Storable a' => a' -> Ptr a' -> Ptr a' -> Int -> IO ()
253     doMove dummy dest src size  = moveBytes dest src (size * sizeOf dummy)
254
255
256 -- finding the length
257 -- ------------------
258
259 -- |Return the number of elements in an array, excluding the terminator
260 --
261 lengthArray0            :: (Storable a, Eq a) => a -> Ptr a -> IO Int
262 lengthArray0 marker ptr  = loop 0
263   where
264     loop i = do
265         val <- peekElemOff ptr i
266         if val == marker then return i else loop (i+1)
267
268
269 -- indexing
270 -- --------
271
272 -- |Advance a pointer into an array by the given number of elements
273 --
274 advancePtr :: Storable a => Ptr a -> Int -> Ptr a
275 advancePtr  = doAdvance undefined
276   where
277     doAdvance             :: Storable a' => a' -> Ptr a' -> Int -> Ptr a'
278     doAdvance dummy ptr i  = ptr `plusPtr` (i * sizeOf dummy)