X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FArray%2FBase.hs;h=d007bf4a0e8cdb37730a9b3d52c75043b78c50e8;hb=a03b10415390db95c2e52523de86dd592ba19471;hp=0cc0df5dbf96fb166973e9b6411d12cddcf745c7;hpb=a612923878a826915b5c8ef9d80cfc4bfc5c3efd;p=haskell-directory.git diff --git a/Data/Array/Base.hs b/Data/Array/Base.hs index 0cc0df5..d007bf4 100644 --- a/Data/Array/Base.hs +++ b/Data/Array/Base.hs @@ -41,6 +41,7 @@ import GHC.Float ( Float(..), Double(..) ) import GHC.Stable ( StablePtr(..) ) import GHC.Int ( Int8(..), Int16(..), Int32(..), Int64(..) ) import GHC.Word ( Word8(..), Word16(..), Word32(..), Word64(..) ) +import GHC.IOBase ( IO(..) ) #endif #ifdef __HUGS__ @@ -1520,9 +1521,14 @@ freezeSTUArray :: Ix i => STUArray s i e -> ST s (UArray i e) freezeSTUArray (STUArray l u marr#) = ST $ \s1# -> case sizeofMutableByteArray# marr# of { n# -> case newByteArray# n# s1# of { (# s2#, marr'# #) -> - case unsafeCoerce# memcpy marr'# marr# n# s2# of { (# s3#, () #) -> + case memcpy_freeze marr'# marr# (fromIntegral (I# n#)) of { IO m -> + case unsafeCoerce# m s2# of { (# s3#, _ #) -> case unsafeFreezeByteArray# marr'# s3# of { (# s4#, arr# #) -> - (# s4#, UArray l u arr# #) }}}} + (# s4#, UArray l u arr# #) }}}}} + +foreign import ccall unsafe "memcpy" + memcpy_freeze :: MutableByteArray# s -> MutableByteArray# s -> CSize + -> IO (Ptr a) {-# RULES "freeze/STArray" freeze = ArrST.freezeSTArray @@ -1590,11 +1596,12 @@ thawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e) thawSTUArray (UArray l u arr#) = ST $ \s1# -> case sizeofByteArray# arr# of { n# -> case newByteArray# n# s1# of { (# s2#, marr# #) -> - case unsafeCoerce# memcpy marr# arr# n# s2# of { (# s3#, () #) -> - (# s3#, STUArray l u marr# #) }}} + case memcpy_thaw marr# arr# (fromIntegral (I# n#)) of { IO m -> + case unsafeCoerce# m s2# of { (# s3#, _ #) -> + (# s3#, STUArray l u marr# #) }}}} foreign import ccall unsafe "memcpy" - memcpy :: MutableByteArray# RealWorld -> ByteArray# -> CSize + memcpy_thaw :: MutableByteArray# s -> ByteArray# -> CSize -> IO (Ptr a) {-# RULES