Data/Array/Storable.hs

   1 -----------------------------------------------------------------------------
   2 -- |
   3 -- Module      :  Data.Array.Storable
   4 -- Copyright   :  (c) The University of Glasgow 2001
   5 -- License     :  BSD-style (see the file libraries/base/LICENSE)
   6 --
   7 -- Maintainer  :  libraries@haskell.org
   8 -- Stability   :  experimental
   9 -- Portability :  non-portable
  10 --
  11 -- A storable array is an IO-mutable array which stores its
  12 -- contents in a contiguous memory block living in the C
  13 -- heap. Elements are stored according to the class Storable.
  14 -- You can obtain the pointer to the array contents to manipulate
  15 -- elements from languages like C.
  16 --
  17 -- It's similar to IOUArray but slower. Its advantage is that
  18 -- it's compatible with C.
  19 --
  20 -----------------------------------------------------------------------------
  21
  22 module Data.Array.Storable (
  23
  24     -- Array type:
  25     StorableArray, -- data StorableArray index element
  26                    --     -- index type must be in class Ix
  27                    --     -- element type must be in class Storable
  28
  29     -- Module MArray provides the interface of storable arrays.
  30     -- They are instances of class MArray (with IO monad).
  31     module Data.Array.MArray,
  32
  33     withStorableArray,
  34     unsafeStorableArrayToPtr, touchStorableArray,
  35     unsafeStorableArrayToIOUArray
  36     )
  37     where
  38
  39 import Prelude
  40
  41 #ifdef __GLASGOW_HASKELL__
  42 import GHC.Exts
  43 import GHC.IOBase       ( IO(..) )
  44 import GHC.Word
  45 import GHC.Int
  46 import GHC.Stable       ( StablePtr(..) )
  47 #endif
  48
  49 import Data.Array.Base
  50 import Data.Array.MArray
  51 import Data.Array.IO.Internals  ( IOUArray(..) )
  52 import Foreign hiding (newArray)
  53
  54 data StorableArray i e = StorableArray !i !i !(MutableByteArray# RealWorld)
  55
  56 instance HasBounds StorableArray where
  57     bounds (StorableArray l u _) = (l,u)
  58
  59 newStorableArray :: (Ix ix, Storable e) => (ix,ix) -> IO (StorableArray ix e)
  60 #ifndef __HADDOCK__
  61 newStorableArray (l,u) :: IO (StorableArray ix e) = IO $ \s1# ->
  62   case rangeSize (l,u)            of { I# n# ->
  63   let I# size = sizeOf (undefined :: e) in
  64   case newPinnedByteArray# (size *# n#) s1# of { (# s2#, marr# #) ->
  65   (# s2#, StorableArray l u marr# #) }}
  66 #endif
  67
  68 -- | Convert a 'StorableArray' into a 'Ptr' for the duration of the
  69 -- specified IO action.  The 'Ptr' is not valid outside the IO action, so
  70 -- don't return it and use it later.
  71 withStorableArray :: StorableArray i e -> (Ptr e -> IO a) -> IO a
  72 withStorableArray arr f = do
  73   r <- f (unsafeStorableArrayToPtr arr)
  74   touchStorableArray arr
  75   return r
  76
  77 -- | Converts a 'StorableArray' into a 'Ptr'.  This function is unsafe, because
  78 -- it does not ensure that the 'StorableArray' is kept alive.  Should be used
  79 -- in conjunction with 'touchStorableArray'.
  80 unsafeStorableArrayToPtr :: StorableArray i e -> Ptr a
  81 unsafeStorableArrayToPtr (StorableArray _ _ arr#)
  82  = Ptr (byteArrayContents# (unsafeCoerce# arr#))
  83
  84 -- | For use in conjunction with 'unsafeStorableArrayToPtr'.  Applying
  85 -- 'touchStorableArray' to the 'StorableArray' ensures that the array
  86 -- will not be garbage collected before that point.  (NOTE: 'withStorableArray'
  87 -- is preferable to 'unsafeStorableArrayToPtr'\/'touchStorableArray').
  88 touchStorableArray :: StorableArray i e -> IO ()
  89 touchStorableArray (StorableArray _ _ arr#) = IO $ \s ->
  90   case touch# arr# s of s2 -> (# s2, () #)
  91
  92 -- | Coerces a 'StorableArray' into an 'IOUArray'.  This is safe as
  93 -- long as the representation of the elements is the same, which is
  94 -- currently true for all element types except 'Bool'.
  95 --
  96 -- Going the other direction would be less safe, however, because the
  97 -- byte array in an 'IOUArray' might not be pinned, so using
  98 -- 'withStorableArray' on the resulting 'StorableArray' would not be safe.
  99 --
 100 -- Bear in mind that you might not be able to /use/ the 'IOUArray' unless
 101 -- the element type is supported by one of the available instances of
 102 -- MArray.
 103 unsafeStorableArrayToIOUArray :: StorableArray i e -> IOUArray i e
 104 unsafeStorableArrayToIOUArray (StorableArray l u arr#)
 105   = IOUArray (STUArray l u arr#)
 106
 107 -- The general case
 108 instance Storable e => MArray StorableArray e IO where
 109     newArray_ = newStorableArray
 110     unsafeRead  a i   = withStorableArray a $ \p -> peekElemOff p i
 111     unsafeWrite a i e = withStorableArray a $ \p -> pokeElemOff p i e
 112
 113 {-# RULES
 114 "unsafeRead/StorableArray/Char"   unsafeRead  = unsafeReadChar
 115 "unsafeWrite/StorableArray/Char"  unsafeWrite = unsafeWriteChar
 116 "unsafeRead/StorableArray/Int"   unsafeRead  = unsafeReadInt
 117 "unsafeWrite/StorableArray/Int"  unsafeWrite = unsafeWriteInt
 118 "unsafeRead/StorableArray/Word"   unsafeRead  = unsafeReadWord
 119 "unsafeWrite/StorableArray/Word"   unsafeWrite  = unsafeWriteWord
 120 "unsafeRead/StorableArray/Ptr"   unsafeRead  = unsafeReadPtr
 121 "unsafeWrite/StorableArray/Ptr"  unsafeWrite = unsafeWritePtr
 122 "unsafeRead/StorableArray/FunPtr"   unsafeRead  = unsafeReadFunPtr
 123 "unsafeWrite/StorableArray/FunPtr"  unsafeWrite = unsafeWriteFunPtr
 124 "unsafeRead/StorableArray/Float"   unsafeRead  = unsafeReadFloat
 125 "unsafeWrite/StorableArray/Float"  unsafeWrite = unsafeWriteFloat
 126 "unsafeRead/StorableArray/Double"   unsafeRead  = unsafeReadDouble
 127 "unsafeWrite/StorableArray/Double"  unsafeWrite = unsafeWriteDouble
 128 "unsafeRead/StorableArray/StablePtr"   unsafeRead  = unsafeReadStablePtr
 129 "unsafeWrite/StorableArray/StablePtr"  unsafeWrite = unsafeWriteStablePtr
 130 "unsafeRead/StorableArray/Int8"    unsafeRead  = unsafeReadInt8
 131 "unsafeWrite/StorableArray/Int8"   unsafeWrite = unsafeWriteInt8
 132 "unsafeRead/StorableArray/Int16"   unsafeRead  = unsafeReadInt16
 133 "unsafeWrite/StorableArray/Int16"  unsafeWrite = unsafeWriteInt16
 134 "unsafeRead/StorableArray/Int32"   unsafeRead  = unsafeReadInt32
 135 "unsafeWrite/StorableArray/Int32"  unsafeWrite = unsafeWriteInt32
 136 "unsafeRead/StorableArray/Int64"   unsafeRead  = unsafeReadInt64
 137 "unsafeWrite/StorableArray/Int64"  unsafeWrite = unsafeWriteInt64
 138 "unsafeRead/StorableArray/Word8"   unsafeRead  = unsafeReadWord8
 139 "unsafeWrite/StorableArray/Word8"  unsafeWrite = unsafeWriteWord8
 140 "unsafeRead/StorableArray/Word16"  unsafeRead  = unsafeReadWord16
 141 "unsafeWrite/StorableArray/Word16" unsafeWrite = unsafeWriteWord16
 142 "unsafeRead/StorableArray/Word32"  unsafeRead  = unsafeReadWord32
 143 "unsafeWrite/StorableArray/Word32" unsafeWrite = unsafeWriteWord32
 144 "unsafeRead/StorableArray/Word64"  unsafeRead  = unsafeReadWord64
 145 "unsafeWrite/StorableArray/Word64" unsafeWrite = unsafeWriteWord64
 146  #-}
 147
 148 {-# INLINE unsafeReadChar #-}
 149 unsafeReadChar :: StorableArray ix Char -> Int -> IO Char
 150 unsafeReadChar (StorableArray _ _ marr#) (I# i#) = IO $ \s1# ->
 151         case readWideCharArray# marr# i# s1# of { (# s2#, e# #) ->
 152         (# s2#, C# e# #) }
 153
 154 {-# INLINE unsafeReadInt #-}
 155 unsafeReadInt :: StorableArray ix Int -> Int -> IO Int
 156 unsafeReadInt (StorableArray _ _ marr#) (I# i#) = IO $ \s1# ->
 157         case readIntArray# marr# i# s1# of { (# s2#, e# #) ->
 158         (# s2#, I# e# #) }
 159
 160 {-# INLINE unsafeReadWord #-}
 161 unsafeReadWord :: StorableArray ix Word -> Int -> IO Word
 162 unsafeReadWord (StorableArray _ _ marr#) (I# i#) = IO $ \s1# ->
 163         case readWordArray# marr# i# s1# of { (# s2#, e# #) ->
 164         (# s2#, W# e# #) }
 165
 166 {-# INLINE unsafeReadPtr #-}
 167 unsafeReadPtr :: StorableArray ix (Ptr a) -> Int -> IO (Ptr a)
 168 unsafeReadPtr (StorableArray _ _ marr#) (I# i#) = IO $ \s1# ->
 169         case readAddrArray# marr# i# s1# of { (# s2#, e# #) ->
 170         (# s2#, Ptr e# #) }
 171
 172 {-# INLINE unsafeReadFunPtr #-}
 173 unsafeReadFunPtr :: StorableArray ix (FunPtr a) -> Int -> IO (FunPtr a)
 174 unsafeReadFunPtr (StorableArray _ _ marr#) (I# i#) = IO $ \s1# ->
 175         case readAddrArray# marr# i# s1# of { (# s2#, e# #) ->
 176         (# s2#, FunPtr e# #) }
 177
 178 {-# INLINE unsafeReadFloat #-}
 179 unsafeReadFloat :: StorableArray ix Float -> Int -> IO Float
 180 unsafeReadFloat (StorableArray _ _ marr#) (I# i#) = IO $ \s1# ->
 181         case readFloatArray# marr# i# s1# of { (# s2#, e# #) ->
 182         (# s2#, F# e# #) }
 183
 184 {-# INLINE unsafeReadDouble #-}
 185 unsafeReadDouble :: StorableArray ix Double -> Int -> IO Double
 186 unsafeReadDouble (StorableArray _ _ marr#) (I# i#) = IO $ \s1# ->
 187         case readDoubleArray# marr# i# s1# of { (# s2#, e# #) ->
 188         (# s2#, D# e# #) }
 189
 190 {-# INLINE unsafeReadStablePtr #-}
 191 unsafeReadStablePtr :: StorableArray ix (StablePtr a) -> Int -> IO (StablePtr a)
 192 unsafeReadStablePtr (StorableArray _ _ marr#) (I# i#) = IO $ \s1# ->
 193         case readStablePtrArray# marr# i# s1# of { (# s2#, e# #) ->
 194         (# s2#, StablePtr e# #) }
 195
 196 {-# INLINE unsafeReadInt8 #-}
 197 unsafeReadInt8 :: StorableArray ix Int8 -> Int -> IO Int8
 198 unsafeReadInt8 (StorableArray _ _ marr#) (I# i#) = IO $ \s1# ->
 199         case readInt8Array# marr# i# s1# of { (# s2#, e# #) ->
 200         (# s2#, I8# e# #) }
 201
 202 {-# INLINE unsafeReadInt16 #-}
 203 unsafeReadInt16 :: StorableArray ix Int16 -> Int -> IO Int16
 204 unsafeReadInt16 (StorableArray _ _ marr#) (I# i#) = IO $ \s1# ->
 205         case readInt16Array# marr# i# s1# of { (# s2#, e# #) ->
 206         (# s2#, I16# e# #) }
 207
 208 {-# INLINE unsafeReadInt32 #-}
 209 unsafeReadInt32 :: StorableArray ix Int32 -> Int -> IO Int32
 210 unsafeReadInt32 (StorableArray _ _ marr#) (I# i#) = IO $ \s1# ->
 211         case readInt32Array# marr# i# s1# of { (# s2#, e# #) ->
 212         (# s2#, I32# e# #) }
 213
 214 {-# INLINE unsafeReadInt64 #-}
 215 unsafeReadInt64 :: StorableArray ix Int64 -> Int -> IO Int64
 216 unsafeReadInt64 (StorableArray _ _ marr#) (I# i#) = IO $ \s1# ->
 217         case readInt64Array# marr# i# s1# of { (# s2#, e# #) ->
 218         (# s2#, I64# e# #) }
 219
 220 {-# INLINE unsafeReadWord8 #-}
 221 unsafeReadWord8 :: StorableArray ix Word8 -> Int -> IO Word8
 222 unsafeReadWord8 (StorableArray _ _ marr#) (I# i#) = IO $ \s1# ->
 223         case readWord8Array# marr# i# s1# of { (# s2#, e# #) ->
 224         (# s2#, W8# e# #) }
 225
 226 {-# INLINE unsafeReadWord16 #-}
 227 unsafeReadWord16 :: StorableArray ix Word16 -> Int -> IO Word16
 228 unsafeReadWord16 (StorableArray _ _ marr#) (I# i#) = IO $ \s1# ->
 229         case readWord16Array# marr# i# s1# of { (# s2#, e# #) ->
 230         (# s2#, W16# e# #) }
 231
 232 {-# INLINE unsafeReadWord32 #-}
 233 unsafeReadWord32 :: StorableArray ix Word32 -> Int -> IO Word32
 234 unsafeReadWord32 (StorableArray _ _ marr#) (I# i#) = IO $ \s1# ->
 235         case readWord32Array# marr# i# s1# of { (# s2#, e# #) ->
 236         (# s2#, W32# e# #) }
 237
 238 {-# INLINE unsafeReadWord64 #-}
 239 unsafeReadWord64 :: StorableArray ix Word64 -> Int -> IO Word64
 240 unsafeReadWord64 (StorableArray _ _ marr#) (I# i#) = IO $ \s1# ->
 241         case readWord64Array# marr# i# s1# of { (# s2#, e# #) ->
 242         (# s2#, W64# e# #) }
 243
 244 {-# INLINE unsafeWriteChar #-}
 245 unsafeWriteChar :: StorableArray ix Char -> Int -> Char -> IO ()
 246 unsafeWriteChar (StorableArray _ _ marr#) (I# i#) (C# e#) = IO $ \s1# ->
 247         case writeWideCharArray# marr# i# e# s1# of { s2# ->
 248         (# s2#, () #) }
 249
 250 {-# INLINE unsafeWriteInt #-}
 251 unsafeWriteInt :: StorableArray ix Int -> Int -> Int -> IO ()
 252 unsafeWriteInt (StorableArray _ _ marr#) (I# i#) (I# e#) = IO $ \s1# ->
 253         case writeIntArray# marr# i# e# s1# of { s2# ->
 254         (# s2#, () #) }
 255
 256 {-# INLINE unsafeWriteWord #-}
 257 unsafeWriteWord :: StorableArray ix Word -> Int -> Word -> IO ()
 258 unsafeWriteWord (StorableArray _ _ marr#) (I# i#) (W# e#) = IO $ \s1# ->
 259         case writeWordArray# marr# i# e# s1# of { s2# ->
 260         (# s2#, () #) }
 261
 262 {-# INLINE unsafeWritePtr #-}
 263 unsafeWritePtr :: StorableArray ix (Ptr a) -> Int -> (Ptr a) -> IO ()
 264 unsafeWritePtr (StorableArray _ _ marr#) (I# i#) (Ptr e#) = IO $ \s1# ->
 265         case writeAddrArray# marr# i# e# s1# of { s2# ->
 266         (# s2#, () #) }
 267
 268 {-# INLINE unsafeWriteFunPtr #-}
 269 unsafeWriteFunPtr :: StorableArray ix (FunPtr a) -> Int -> (FunPtr a) -> IO ()
 270 unsafeWriteFunPtr (StorableArray _ _ marr#) (I# i#) (FunPtr e#) = IO $ \s1# ->
 271         case writeAddrArray# marr# i# e# s1# of { s2# ->
 272         (# s2#, () #) }
 273
 274 {-# INLINE unsafeWriteFloat #-}
 275 unsafeWriteFloat :: StorableArray ix Float -> Int -> Float -> IO ()
 276 unsafeWriteFloat (StorableArray _ _ marr#) (I# i#) (F# e#) = IO $ \s1# ->
 277         case writeFloatArray# marr# i# e# s1# of { s2# ->
 278         (# s2#, () #) }
 279
 280 {-# INLINE unsafeWriteDouble #-}
 281 unsafeWriteDouble :: StorableArray ix Double -> Int -> Double -> IO ()
 282 unsafeWriteDouble (StorableArray _ _ marr#) (I# i#) (D# e#) = IO $ \s1# ->
 283         case writeDoubleArray# marr# i# e# s1# of { s2# ->
 284         (# s2#, () #) }
 285
 286 {-# INLINE unsafeWriteStablePtr #-}
 287 unsafeWriteStablePtr :: StorableArray ix (StablePtr a) -> Int -> (StablePtr a) -> IO ()
 288 unsafeWriteStablePtr (StorableArray _ _ marr#) (I# i#) (StablePtr e#) = IO $ \s1# ->
 289         case writeStablePtrArray# marr# i# e# s1# of { s2# ->
 290         (# s2#, () #) }
 291
 292 {-# INLINE unsafeWriteInt8 #-}
 293 unsafeWriteInt8 :: StorableArray ix Int8 -> Int -> Int8 -> IO ()
 294 unsafeWriteInt8 (StorableArray _ _ marr#) (I# i#) (I8# e#) = IO $ \s1# ->
 295         case writeInt8Array# marr# i# e# s1# of { s2# ->
 296         (# s2#, () #) }
 297
 298 {-# INLINE unsafeWriteInt16 #-}
 299 unsafeWriteInt16 :: StorableArray ix Int16 -> Int -> Int16 -> IO ()
 300 unsafeWriteInt16 (StorableArray _ _ marr#) (I# i#) (I16# e#) = IO $ \s1# ->
 301         case writeInt16Array# marr# i# e# s1# of { s2# ->
 302         (# s2#, () #) }
 303
 304 {-# INLINE unsafeWriteInt32 #-}
 305 unsafeWriteInt32 :: StorableArray ix Int32 -> Int -> Int32 -> IO ()
 306 unsafeWriteInt32 (StorableArray _ _ marr#) (I# i#) (I32# e#) = IO $ \s1# ->
 307         case writeInt32Array# marr# i# e# s1# of { s2# ->
 308         (# s2#, () #) }
 309
 310 {-# INLINE unsafeWriteInt64 #-}
 311 unsafeWriteInt64 :: StorableArray ix Int64 -> Int -> Int64 -> IO ()
 312 unsafeWriteInt64 (StorableArray _ _ marr#) (I# i#) (I64# e#) = IO $ \s1# ->
 313         case writeInt64Array# marr# i# e# s1# of { s2# ->
 314         (# s2#, () #) }
 315
 316 {-# INLINE unsafeWriteWord8 #-}
 317 unsafeWriteWord8 :: StorableArray ix Word8 -> Int -> Word8 -> IO ()
 318 unsafeWriteWord8 (StorableArray _ _ marr#) (I# i#) (W8# e#) = IO $ \s1# ->
 319         case writeWord8Array# marr# i# e# s1# of { s2# ->
 320         (# s2#, () #) }
 321
 322 {-# INLINE unsafeWriteWord16 #-}
 323 unsafeWriteWord16 :: StorableArray ix Word16 -> Int -> Word16 -> IO ()
 324 unsafeWriteWord16 (StorableArray _ _ marr#) (I# i#) (W16# e#) = IO $ \s1# ->
 325         case writeWord16Array# marr# i# e# s1# of { s2# ->
 326         (# s2#, () #) }
 327
 328 {-# INLINE unsafeWriteWord32 #-}
 329 unsafeWriteWord32 :: StorableArray ix Word32 -> Int -> Word32 -> IO ()
 330 unsafeWriteWord32 (StorableArray _ _ marr#) (I# i#) (W32# e#) = IO $ \s1# ->
 331         case writeWord32Array# marr# i# e# s1# of { s2# ->
 332         (# s2#, () #) }
 333
 334 {-# INLINE unsafeWriteWord64 #-}
 335 unsafeWriteWord64 :: StorableArray ix Word64 -> Int -> Word64 -> IO ()
 336 unsafeWriteWord64 (StorableArray _ _ marr#) (I# i#) (W64# e#) = IO $ \s1# ->
 337         case writeWord64Array# marr# i# e# s1# of { s2# ->
 338         (# s2#, () #) }