-- They are instances of class MArray (with IO monad).
module Data.Array.MArray,
- withStorableArray,
- unsafeStorableArrayToPtr, touchStorableArray,
- unsafeStorableArrayToIOUArray
+ -- The pointer to the array contents is obtained by withStorableArray.
+ -- The idea is similar to ForeignPtr (used internally here). The
+ -- pointer should be used only during execution of the IO action
+ -- retured by the function passed as argument to withStorableArray:
+ withStorableArray, -- :: StorableArray i e -> (Ptr e -> IO a) -> IO a
+
+ -- If you want to use it afterwards, ensure that you
+ -- touchStorableArray after the last use of the pointer,
+ -- so the array is not freed too early:
+ touchStorableArray -- :: StorableArray i e -> IO ()
)
where
import Prelude
-#ifdef __GLASGOW_HASKELL__
-import GHC.Exts
-import GHC.IOBase ( IO(..) )
-import GHC.Word
-import GHC.Int
-import GHC.Stable ( StablePtr(..) )
-#endif
-
import Data.Array.Base
import Data.Array.MArray
-import Data.Array.IO.Internals ( IOUArray(..) )
import Foreign hiding (newArray)
-data StorableArray i e = StorableArray !i !i !(MutableByteArray# RealWorld)
+data StorableArray i e = StorableArray !i !i !(ForeignPtr e)
instance HasBounds StorableArray where
bounds (StorableArray l u _) = (l,u)
-newStorableArray :: (Ix ix, Storable e) => (ix,ix) -> IO (StorableArray ix e)
-#ifndef __HADDOCK__
-newStorableArray (l,u) :: IO (StorableArray ix e) = IO $ \s1# ->
- case rangeSize (l,u) of { I# n# ->
- let I# size = sizeOf (undefined :: e) in
- case newPinnedByteArray# (size *# n#) s1# of { (# s2#, marr# #) ->
- (# s2#, StorableArray l u marr# #) }}
-#endif
-
--- | Convert a 'StorableArray' into a 'Ptr' for the duration of the
--- specified IO action. The 'Ptr' is not valid outside the IO action, so
--- don't return it and use it later.
-withStorableArray :: StorableArray i e -> (Ptr e -> IO a) -> IO a
-withStorableArray arr f = do
- r <- f (unsafeStorableArrayToPtr arr)
- touchStorableArray arr
- return r
-
--- | Converts a 'StorableArray' into a 'Ptr'. This function is unsafe, because
--- it does not ensure that the 'StorableArray' is kept alive. Should be used
--- in conjunction with 'touchStorableArray'.
-unsafeStorableArrayToPtr :: StorableArray i e -> Ptr a
-unsafeStorableArrayToPtr (StorableArray _ _ arr#)
- = Ptr (byteArrayContents# (unsafeCoerce# arr#))
-
--- | For use in conjunction with 'unsafeStorableArrayToPtr'. Applying
--- 'touchStorableArray' to the 'StorableArray' ensures that the array
--- will not be garbage collected before that point. (NOTE: 'withStorableArray'
--- is preferable to 'unsafeStorableArrayToPtr'\/'touchStorableArray').
-touchStorableArray :: StorableArray i e -> IO ()
-touchStorableArray (StorableArray _ _ arr#) = IO $ \s ->
- case touch# arr# s of s2 -> (# s2, () #)
-
--- | Coerces a 'StorableArray' into an 'IOUArray'. This is safe as
--- long as the representation of the elements is the same, which is
--- currently true for all element types except 'Bool'.
---
--- Going the other direction would be less safe, however, because the
--- byte array in an 'IOUArray' might not be pinned, so using
--- 'withStorableArray' on the resulting 'StorableArray' would not be safe.
---
--- Bear in mind that you might not be able to /use/ the 'IOUArray' unless
--- the element type is supported by one of the available instances of
--- MArray.
-unsafeStorableArrayToIOUArray :: StorableArray i e -> IOUArray i e
-unsafeStorableArrayToIOUArray (StorableArray l u arr#)
- = IOUArray (STUArray l u arr#)
-
--- The general case
instance Storable e => MArray StorableArray e IO where
- newArray_ = newStorableArray
- unsafeRead a i = withStorableArray a $ \p -> peekElemOff p i
- unsafeWrite a i e = withStorableArray a $ \p -> pokeElemOff p i e
-
-{-# RULES
-"unsafeRead/StorableArray/Char" unsafeRead = unsafeReadChar
-"unsafeWrite/StorableArray/Char" unsafeWrite = unsafeWriteChar
-"unsafeRead/StorableArray/Int" unsafeRead = unsafeReadInt
-"unsafeWrite/StorableArray/Int" unsafeWrite = unsafeWriteInt
-"unsafeRead/StorableArray/Word" unsafeRead = unsafeReadWord
-"unsafeWrite/StorableArray/Word" unsafeWrite = unsafeWriteWord
-"unsafeRead/StorableArray/Ptr" unsafeRead = unsafeReadPtr
-"unsafeWrite/StorableArray/Ptr" unsafeWrite = unsafeWritePtr
-"unsafeRead/StorableArray/FunPtr" unsafeRead = unsafeReadFunPtr
-"unsafeWrite/StorableArray/FunPtr" unsafeWrite = unsafeWriteFunPtr
-"unsafeRead/StorableArray/Float" unsafeRead = unsafeReadFloat
-"unsafeWrite/StorableArray/Float" unsafeWrite = unsafeWriteFloat
-"unsafeRead/StorableArray/Double" unsafeRead = unsafeReadDouble
-"unsafeWrite/StorableArray/Double" unsafeWrite = unsafeWriteDouble
-"unsafeRead/StorableArray/StablePtr" unsafeRead = unsafeReadStablePtr
-"unsafeWrite/StorableArray/StablePtr" unsafeWrite = unsafeWriteStablePtr
-"unsafeRead/StorableArray/Int8" unsafeRead = unsafeReadInt8
-"unsafeWrite/StorableArray/Int8" unsafeWrite = unsafeWriteInt8
-"unsafeRead/StorableArray/Int16" unsafeRead = unsafeReadInt16
-"unsafeWrite/StorableArray/Int16" unsafeWrite = unsafeWriteInt16
-"unsafeRead/StorableArray/Int32" unsafeRead = unsafeReadInt32
-"unsafeWrite/StorableArray/Int32" unsafeWrite = unsafeWriteInt32
-"unsafeRead/StorableArray/Int64" unsafeRead = unsafeReadInt64
-"unsafeWrite/StorableArray/Int64" unsafeWrite = unsafeWriteInt64
-"unsafeRead/StorableArray/Word8" unsafeRead = unsafeReadWord8
-"unsafeWrite/StorableArray/Word8" unsafeWrite = unsafeWriteWord8
-"unsafeRead/StorableArray/Word16" unsafeRead = unsafeReadWord16
-"unsafeWrite/StorableArray/Word16" unsafeWrite = unsafeWriteWord16
-"unsafeRead/StorableArray/Word32" unsafeRead = unsafeReadWord32
-"unsafeWrite/StorableArray/Word32" unsafeWrite = unsafeWriteWord32
-"unsafeRead/StorableArray/Word64" unsafeRead = unsafeReadWord64
-"unsafeWrite/StorableArray/Word64" unsafeWrite = unsafeWriteWord64
- #-}
-
-{-# INLINE unsafeReadChar #-}
-unsafeReadChar :: StorableArray ix Char -> Int -> IO Char
-unsafeReadChar (StorableArray _ _ marr#) (I# i#) = IO $ \s1# ->
- case readWideCharArray# marr# i# s1# of { (# s2#, e# #) ->
- (# s2#, C# e# #) }
-
-{-# INLINE unsafeReadInt #-}
-unsafeReadInt :: StorableArray ix Int -> Int -> IO Int
-unsafeReadInt (StorableArray _ _ marr#) (I# i#) = IO $ \s1# ->
- case readIntArray# marr# i# s1# of { (# s2#, e# #) ->
- (# s2#, I# e# #) }
-
-{-# INLINE unsafeReadWord #-}
-unsafeReadWord :: StorableArray ix Word -> Int -> IO Word
-unsafeReadWord (StorableArray _ _ marr#) (I# i#) = IO $ \s1# ->
- case readWordArray# marr# i# s1# of { (# s2#, e# #) ->
- (# s2#, W# e# #) }
-
-{-# INLINE unsafeReadPtr #-}
-unsafeReadPtr :: StorableArray ix (Ptr a) -> Int -> IO (Ptr a)
-unsafeReadPtr (StorableArray _ _ marr#) (I# i#) = IO $ \s1# ->
- case readAddrArray# marr# i# s1# of { (# s2#, e# #) ->
- (# s2#, Ptr e# #) }
-
-{-# INLINE unsafeReadFunPtr #-}
-unsafeReadFunPtr :: StorableArray ix (FunPtr a) -> Int -> IO (FunPtr a)
-unsafeReadFunPtr (StorableArray _ _ marr#) (I# i#) = IO $ \s1# ->
- case readAddrArray# marr# i# s1# of { (# s2#, e# #) ->
- (# s2#, FunPtr e# #) }
-
-{-# INLINE unsafeReadFloat #-}
-unsafeReadFloat :: StorableArray ix Float -> Int -> IO Float
-unsafeReadFloat (StorableArray _ _ marr#) (I# i#) = IO $ \s1# ->
- case readFloatArray# marr# i# s1# of { (# s2#, e# #) ->
- (# s2#, F# e# #) }
-
-{-# INLINE unsafeReadDouble #-}
-unsafeReadDouble :: StorableArray ix Double -> Int -> IO Double
-unsafeReadDouble (StorableArray _ _ marr#) (I# i#) = IO $ \s1# ->
- case readDoubleArray# marr# i# s1# of { (# s2#, e# #) ->
- (# s2#, D# e# #) }
-
-{-# INLINE unsafeReadStablePtr #-}
-unsafeReadStablePtr :: StorableArray ix (StablePtr a) -> Int -> IO (StablePtr a)
-unsafeReadStablePtr (StorableArray _ _ marr#) (I# i#) = IO $ \s1# ->
- case readStablePtrArray# marr# i# s1# of { (# s2#, e# #) ->
- (# s2#, StablePtr e# #) }
-{-# INLINE unsafeReadInt8 #-}
-unsafeReadInt8 :: StorableArray ix Int8 -> Int -> IO Int8
-unsafeReadInt8 (StorableArray _ _ marr#) (I# i#) = IO $ \s1# ->
- case readInt8Array# marr# i# s1# of { (# s2#, e# #) ->
- (# s2#, I8# e# #) }
+ newArray (l,u) init = do
+ fp <- mallocForeignPtrArray size
+ withForeignPtr fp $ \a ->
+ sequence_ [pokeElemOff a i init | i <- [0..size-1]]
+ return (StorableArray l u fp)
+ where
+ size = rangeSize (l,u)
-{-# INLINE unsafeReadInt16 #-}
-unsafeReadInt16 :: StorableArray ix Int16 -> Int -> IO Int16
-unsafeReadInt16 (StorableArray _ _ marr#) (I# i#) = IO $ \s1# ->
- case readInt16Array# marr# i# s1# of { (# s2#, e# #) ->
- (# s2#, I16# e# #) }
+ newArray_ (l,u) = do
+ fp <- mallocForeignPtrArray (rangeSize (l,u))
+ return (StorableArray l u fp)
-{-# INLINE unsafeReadInt32 #-}
-unsafeReadInt32 :: StorableArray ix Int32 -> Int -> IO Int32
-unsafeReadInt32 (StorableArray _ _ marr#) (I# i#) = IO $ \s1# ->
- case readInt32Array# marr# i# s1# of { (# s2#, e# #) ->
- (# s2#, I32# e# #) }
+ unsafeRead (StorableArray _ _ fp) i =
+ withForeignPtr fp $ \a -> peekElemOff a i
-{-# INLINE unsafeReadInt64 #-}
-unsafeReadInt64 :: StorableArray ix Int64 -> Int -> IO Int64
-unsafeReadInt64 (StorableArray _ _ marr#) (I# i#) = IO $ \s1# ->
- case readInt64Array# marr# i# s1# of { (# s2#, e# #) ->
- (# s2#, I64# e# #) }
+ unsafeWrite (StorableArray _ _ fp) i e =
+ withForeignPtr fp $ \a -> pokeElemOff a i e
-{-# INLINE unsafeReadWord8 #-}
-unsafeReadWord8 :: StorableArray ix Word8 -> Int -> IO Word8
-unsafeReadWord8 (StorableArray _ _ marr#) (I# i#) = IO $ \s1# ->
- case readWord8Array# marr# i# s1# of { (# s2#, e# #) ->
- (# s2#, W8# e# #) }
-
-{-# INLINE unsafeReadWord16 #-}
-unsafeReadWord16 :: StorableArray ix Word16 -> Int -> IO Word16
-unsafeReadWord16 (StorableArray _ _ marr#) (I# i#) = IO $ \s1# ->
- case readWord16Array# marr# i# s1# of { (# s2#, e# #) ->
- (# s2#, W16# e# #) }
-
-{-# INLINE unsafeReadWord32 #-}
-unsafeReadWord32 :: StorableArray ix Word32 -> Int -> IO Word32
-unsafeReadWord32 (StorableArray _ _ marr#) (I# i#) = IO $ \s1# ->
- case readWord32Array# marr# i# s1# of { (# s2#, e# #) ->
- (# s2#, W32# e# #) }
-
-{-# INLINE unsafeReadWord64 #-}
-unsafeReadWord64 :: StorableArray ix Word64 -> Int -> IO Word64
-unsafeReadWord64 (StorableArray _ _ marr#) (I# i#) = IO $ \s1# ->
- case readWord64Array# marr# i# s1# of { (# s2#, e# #) ->
- (# s2#, W64# e# #) }
-
-{-# INLINE unsafeWriteChar #-}
-unsafeWriteChar :: StorableArray ix Char -> Int -> Char -> IO ()
-unsafeWriteChar (StorableArray _ _ marr#) (I# i#) (C# e#) = IO $ \s1# ->
- case writeWideCharArray# marr# i# e# s1# of { s2# ->
- (# s2#, () #) }
-
-{-# INLINE unsafeWriteInt #-}
-unsafeWriteInt :: StorableArray ix Int -> Int -> Int -> IO ()
-unsafeWriteInt (StorableArray _ _ marr#) (I# i#) (I# e#) = IO $ \s1# ->
- case writeIntArray# marr# i# e# s1# of { s2# ->
- (# s2#, () #) }
-
-{-# INLINE unsafeWriteWord #-}
-unsafeWriteWord :: StorableArray ix Word -> Int -> Word -> IO ()
-unsafeWriteWord (StorableArray _ _ marr#) (I# i#) (W# e#) = IO $ \s1# ->
- case writeWordArray# marr# i# e# s1# of { s2# ->
- (# s2#, () #) }
-
-{-# INLINE unsafeWritePtr #-}
-unsafeWritePtr :: StorableArray ix (Ptr a) -> Int -> (Ptr a) -> IO ()
-unsafeWritePtr (StorableArray _ _ marr#) (I# i#) (Ptr e#) = IO $ \s1# ->
- case writeAddrArray# marr# i# e# s1# of { s2# ->
- (# s2#, () #) }
-
-{-# INLINE unsafeWriteFunPtr #-}
-unsafeWriteFunPtr :: StorableArray ix (FunPtr a) -> Int -> (FunPtr a) -> IO ()
-unsafeWriteFunPtr (StorableArray _ _ marr#) (I# i#) (FunPtr e#) = IO $ \s1# ->
- case writeAddrArray# marr# i# e# s1# of { s2# ->
- (# s2#, () #) }
-
-{-# INLINE unsafeWriteFloat #-}
-unsafeWriteFloat :: StorableArray ix Float -> Int -> Float -> IO ()
-unsafeWriteFloat (StorableArray _ _ marr#) (I# i#) (F# e#) = IO $ \s1# ->
- case writeFloatArray# marr# i# e# s1# of { s2# ->
- (# s2#, () #) }
-
-{-# INLINE unsafeWriteDouble #-}
-unsafeWriteDouble :: StorableArray ix Double -> Int -> Double -> IO ()
-unsafeWriteDouble (StorableArray _ _ marr#) (I# i#) (D# e#) = IO $ \s1# ->
- case writeDoubleArray# marr# i# e# s1# of { s2# ->
- (# s2#, () #) }
-
-{-# INLINE unsafeWriteStablePtr #-}
-unsafeWriteStablePtr :: StorableArray ix (StablePtr a) -> Int -> (StablePtr a) -> IO ()
-unsafeWriteStablePtr (StorableArray _ _ marr#) (I# i#) (StablePtr e#) = IO $ \s1# ->
- case writeStablePtrArray# marr# i# e# s1# of { s2# ->
- (# s2#, () #) }
-
-{-# INLINE unsafeWriteInt8 #-}
-unsafeWriteInt8 :: StorableArray ix Int8 -> Int -> Int8 -> IO ()
-unsafeWriteInt8 (StorableArray _ _ marr#) (I# i#) (I8# e#) = IO $ \s1# ->
- case writeInt8Array# marr# i# e# s1# of { s2# ->
- (# s2#, () #) }
-
-{-# INLINE unsafeWriteInt16 #-}
-unsafeWriteInt16 :: StorableArray ix Int16 -> Int -> Int16 -> IO ()
-unsafeWriteInt16 (StorableArray _ _ marr#) (I# i#) (I16# e#) = IO $ \s1# ->
- case writeInt16Array# marr# i# e# s1# of { s2# ->
- (# s2#, () #) }
-
-{-# INLINE unsafeWriteInt32 #-}
-unsafeWriteInt32 :: StorableArray ix Int32 -> Int -> Int32 -> IO ()
-unsafeWriteInt32 (StorableArray _ _ marr#) (I# i#) (I32# e#) = IO $ \s1# ->
- case writeInt32Array# marr# i# e# s1# of { s2# ->
- (# s2#, () #) }
-
-{-# INLINE unsafeWriteInt64 #-}
-unsafeWriteInt64 :: StorableArray ix Int64 -> Int -> Int64 -> IO ()
-unsafeWriteInt64 (StorableArray _ _ marr#) (I# i#) (I64# e#) = IO $ \s1# ->
- case writeInt64Array# marr# i# e# s1# of { s2# ->
- (# s2#, () #) }
-
-{-# INLINE unsafeWriteWord8 #-}
-unsafeWriteWord8 :: StorableArray ix Word8 -> Int -> Word8 -> IO ()
-unsafeWriteWord8 (StorableArray _ _ marr#) (I# i#) (W8# e#) = IO $ \s1# ->
- case writeWord8Array# marr# i# e# s1# of { s2# ->
- (# s2#, () #) }
-
-{-# INLINE unsafeWriteWord16 #-}
-unsafeWriteWord16 :: StorableArray ix Word16 -> Int -> Word16 -> IO ()
-unsafeWriteWord16 (StorableArray _ _ marr#) (I# i#) (W16# e#) = IO $ \s1# ->
- case writeWord16Array# marr# i# e# s1# of { s2# ->
- (# s2#, () #) }
-
-{-# INLINE unsafeWriteWord32 #-}
-unsafeWriteWord32 :: StorableArray ix Word32 -> Int -> Word32 -> IO ()
-unsafeWriteWord32 (StorableArray _ _ marr#) (I# i#) (W32# e#) = IO $ \s1# ->
- case writeWord32Array# marr# i# e# s1# of { s2# ->
- (# s2#, () #) }
+withStorableArray :: StorableArray i e -> (Ptr e -> IO a) -> IO a
+withStorableArray (StorableArray _ _ fp) f = withForeignPtr fp f
-{-# INLINE unsafeWriteWord64 #-}
-unsafeWriteWord64 :: StorableArray ix Word64 -> Int -> Word64 -> IO ()
-unsafeWriteWord64 (StorableArray _ _ marr#) (I# i#) (W64# e#) = IO $ \s1# ->
- case writeWord64Array# marr# i# e# s1# of { s2# ->
- (# s2#, () #) }
+touchStorableArray :: StorableArray i e -> IO ()
+touchStorableArray (StorableArray _ _ fp) = touchForeignPtr fp
projects / ghc-base.git / commitdiff