From 42bc2e97c1a8566970da3fe35b79b0c764a303ef Mon Sep 17 00:00:00 2001 From: simonmar Date: Wed, 26 Nov 2003 10:00:09 +0000 Subject: [PATCH] [project @ 2003-11-26 10:00:09 by simonmar] oops, revert accidental commit --- Data/Array/Storable.hs | 315 +++++------------------------------------------- 1 file changed, 29 insertions(+), 286 deletions(-) diff --git a/Data/Array/Storable.hs b/Data/Array/Storable.hs index cf23317..39abe70 100644 --- a/Data/Array/Storable.hs +++ b/Data/Array/Storable.hs @@ -30,309 +30,52 @@ module Data.Array.Storable ( -- 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 -- 1.7.10.4