PrelMarshalArray.lhs 8.33 KB
Newer Older
1
% -----------------------------------------------------------------------------
2
% $Id: PrelMarshalArray.lhs,v 1.7 2001/08/15 09:28:58 simonmar Exp $
3 4 5 6 7 8 9 10
%
% (c) The FFI task force, 2000
%

Marshalling support: routines allocating, storing, and retrieving Haskell
lists that are represented as arrays in the foreign language

\begin{code}
11 12
{-# OPTIONS -fno-implicit-prelude #-}

13 14 15 16
module PrelMarshalArray (

  -- allocation
  --
17 18
  mallocArray,    -- :: Storable a => Int -> IO (Ptr a)
  mallocArray0,   -- :: Storable a => Int -> IO (Ptr a)
19

20 21
  allocaArray,    -- :: Storable a => Int -> (Ptr a -> IO b) -> IO b
  allocaArray0,   -- :: Storable a => Int -> (Ptr a -> IO b) -> IO b
22

23 24
  reallocArray,   -- :: Storable a => Ptr a -> Int -> IO (Ptr a)
  reallocArray0,  -- :: Storable a => Ptr a -> Int -> IO (Ptr a)
25 26 27

  -- marshalling
  --
28 29
  peekArray,      -- :: Storable a =>         Int -> Ptr a -> IO [a]
  peekArray0,     -- :: (Storable a, Eq a) => a   -> Ptr a -> IO [a]
30

31 32
  pokeArray,      -- :: Storable a =>      Ptr a -> [a] -> IO ()
  pokeArray0,     -- :: Storable a => a -> Ptr a -> [a] -> IO ()
33 34 35

  -- combined allocation and marshalling
  --
36 37
  newArray,       -- :: Storable a =>      [a] -> IO (Ptr a)
  newArray0,      -- :: Storable a => a -> [a] -> IO (Ptr a)
38

39 40 41 42 43 44 45
  withArray,      -- :: Storable a =>      [a] -> (Ptr a -> IO b) -> IO b
  withArray0,     -- :: Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b

  -- destruction
  --
  destructArray,  -- :: Storable a =>         Int -> Ptr a -> IO ()
  destructArray0, -- :: (Storable a, Eq a) => a   -> Ptr a -> IO ()
46 47 48

  -- copying (argument order: destination, source)
  --
49 50 51 52 53 54
  copyArray,      -- :: Storable a => Ptr a -> Ptr a -> Int -> IO ()
  moveArray,      -- :: Storable a => Ptr a -> Ptr a -> Int -> IO ()

  -- finding the length
  --
  lengthArray0,   -- :: (Storable a, Eq a) => a -> Ptr a -> IO Int
55 56 57

  -- indexing
  --
58
  advancePtr      -- :: Storable a => Ptr a -> Int -> Ptr a
59 60
) where

61
import Monad
62

63
#ifdef __GLASGOW_HASKELL__
64
import PrelPtr	        (Ptr, plusPtr)
65
import PrelStorable     (Storable(sizeOf,peekElemOff,pokeElemOff,destruct))
66 67
import PrelMarshalAlloc (mallocBytes, allocaBytes, reallocBytes)
import PrelMarshalUtils (copyBytes, moveBytes)
68 69 70 71 72 73
import PrelIOBase
import PrelNum
import PrelList
import PrelErr
import PrelBase
#endif
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

-- allocation
-- ----------

-- allocate storage for the given number of elements of a storable type
--
mallocArray :: Storable a => Int -> IO (Ptr a)
mallocArray  = doMalloc undefined
  where
    doMalloc            :: Storable a => a -> Int -> IO (Ptr a)
    doMalloc dummy size  = mallocBytes (size * sizeOf dummy)

-- like `mallocArray', but add an extra element to signal the end of the array
--
mallocArray0      :: Storable a => Int -> IO (Ptr a)
mallocArray0 size  = mallocArray (size + 1)

-- temporarily allocate space for the given number of elements
--
-- * see `MarshalAlloc.alloca' for the storage lifetime constraints
--
allocaArray :: Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray  = doAlloca undefined
  where
    doAlloca            :: Storable a => a -> Int -> (Ptr a -> IO b) -> IO b
    doAlloca dummy size  = allocaBytes (size * sizeOf dummy)

-- like `allocaArray', but add an extra element to signal the end of the array
--
allocaArray0      :: Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray0 size  = allocaArray (size + 1)

-- adjust the size of an array
--
reallocArray :: Storable a => Ptr a -> Int -> IO (Ptr a)
reallocArray  = doRealloc undefined
  where
    doRealloc                :: Storable a => a -> Ptr a -> Int -> IO (Ptr a)
    doRealloc dummy ptr size  = reallocBytes ptr (size * sizeOf dummy)

-- adjust the size of an array while adding an element for the end marker
--
reallocArray0          :: Storable a => Ptr a -> Int -> IO (Ptr a)
reallocArray0 ptr size  = reallocArray ptr (size + 1)


-- marshalling
-- -----------

123
-- convert an array of given length into a Haskell list.  This version
124 125 126 127
-- traverses the array backwards using an accumulating parameter,
-- which uses constant stack space.  The previous version using mapM
-- needed linear stack space.
--
128
peekArray          :: Storable a => Int -> Ptr a -> IO [a]
129 130
peekArray size ptr | size < 0  = return []
		   | otherwise = f (size-1) []
131 132
  where
    f 0 acc = do e <- peekElemOff ptr 0; return (e:acc)
133
    f n acc = do e <- peekElemOff ptr n; f (n-1) (e:acc)
134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172

-- convert an array terminated by the given end marker into a Haskell list
--
peekArray0            :: (Storable a, Eq a) => a -> Ptr a -> IO [a]
peekArray0 marker ptr  = loop 0
  where
    loop i = do
        val <- peekElemOff ptr i
        if val == marker then return [] else do
            rest <- loop (i+1)
            return (val:rest)

-- write the list elements consecutive into memory
--
pokeArray          :: Storable a => Ptr a -> [a] -> IO ()
pokeArray ptr vals  = zipWithM_ (pokeElemOff ptr) [0..] vals

-- write the list elements consecutive into memory and terminate them with the
-- given marker element
--
pokeArray0		   :: Storable a => a -> Ptr a -> [a] -> IO ()
pokeArray0 marker ptr vals  = do
  pokeArray ptr vals
  pokeElemOff ptr (length vals) marker


-- combined allocation and marshalling
-- -----------------------------------

-- write a list of storable elements into a newly allocated, consecutive
-- sequence of storable values
--
newArray      :: Storable a => [a] -> IO (Ptr a)
newArray vals  = do
  ptr <- mallocArray (length vals)
  pokeArray ptr vals
  return ptr

-- write a list of storable elements into a newly allocated, consecutive
173
-- sequence of storable values, where the end is fixed by the given end marker
174 175 176 177 178 179 180 181 182 183
--
newArray0             :: Storable a => a -> [a] -> IO (Ptr a)
newArray0 marker vals  = do
  ptr <- mallocArray0 (length vals)
  pokeArray0 marker ptr vals
  return ptr

-- temporarily store a list of storable values in memory
--
withArray        :: Storable a => [a] -> (Ptr a -> IO b) -> IO b
184 185 186 187 188 189 190 191
withArray vals f  =
  allocaArray len $ \ptr -> do
      pokeArray ptr vals
      res <- f ptr
      destructArray len ptr
      return res
  where
    len = length vals
192

193
-- like `withArray', but a terminator indicates where the array ends
194 195
--
withArray0               :: Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b
196 197 198 199 200 201 202 203 204 205 206 207
withArray0 marker vals f  =
  allocaArray0 len $ \ptr -> do
      pokeArray0 marker ptr vals
      res <- f ptr
      destructArray (len+1) ptr
      return res
  where
    len = length vals


-- destruction
-- -----------
208

209 210 211 212 213 214 215 216 217 218 219 220 221 222
-- destruct each element of an array (in reverse order)
--
destructArray          :: Storable a => Int -> Ptr a -> IO ()
destructArray size ptr  =
  sequence_ [destruct (ptr `advancePtr` i)
    | i <- [size-1, size-2 .. 0]]

-- like `destructArray', but a terminator indicates where the array ends
--
destructArray0            :: (Storable a, Eq a) => a -> Ptr a -> IO ()
destructArray0 marker ptr  = do
  size <- lengthArray0 marker ptr
  sequence_ [destruct (ptr `advancePtr` i)
    | i <- [size, size-1 .. 0]]
223

224 225

-- copying (argument order: destination, source)
226 227
-- -------

228
-- copy the given number of elements from the second array (source) into the
229 230 231 232 233 234 235 236
-- first array (destination); the copied areas may *not* overlap
--
copyArray :: Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray  = doCopy undefined
  where
    doCopy                     :: Storable a => a -> Ptr a -> Ptr a -> Int -> IO ()
    doCopy dummy dest src size  = copyBytes dest src (size * sizeOf dummy)

237
-- copy the given number of elements from the second array (source) into the
238 239 240 241 242 243 244 245 246
-- first array (destination); the copied areas *may* overlap
--
moveArray :: Storable a => Ptr a -> Ptr a -> Int -> IO ()
moveArray  = doMove undefined
  where
    doMove                     :: Storable a => a -> Ptr a -> Ptr a -> Int -> IO ()
    doMove dummy dest src size  = moveBytes dest src (size * sizeOf dummy)


247 248 249 250 251 252 253 254 255 256 257 258 259
-- finding the length
-- ------------------

-- return the number of elements in an array, excluding the terminator
--
lengthArray0            :: (Storable a, Eq a) => a -> Ptr a -> IO Int
lengthArray0 marker ptr  = loop 0
  where
    loop i = do
        val <- peekElemOff ptr i
        if val == marker then return i else loop (i+1)


260 261 262 263 264 265 266 267 268 269 270 271
-- indexing
-- --------

-- advance a pointer into an array by the given number of elements
--
advancePtr :: Storable a => Ptr a -> Int -> Ptr a
advancePtr  = doAdvance undefined
  where
    doAdvance             :: Storable a => a -> Ptr a -> Int -> Ptr a
    doAdvance dummy ptr i  = ptr `plusPtr` (i * sizeOf dummy)

\end{code}