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