[Haskell-cafe] Re: Array copying

ChrisK haskell at list.mightyreason.com
Mon Dec 3 09:39:31 EST 2007


Reinier Lamers wrote:
> ChrisK wrote:
> 
>> For GHC 6.6 I created
>>
>>  
>>
>>> foreign import ccall unsafe "memcpy"
>>>    memcpy :: MutableByteArray# RealWorld -> MutableByteArray#
>>> RealWorld -> Int# -> IO ()
>>>   
>>
>>  
>>
>>> {-# INLINE copySTU #-}
>>> copySTU :: (Show i,Ix i,MArray (STUArray s) e (ST s)) => STUArray s i
>>> e -> STUArray s i e -> ST s ()
>>> copySTU (STUArray _ _ msource) (STUArray _ _ mdest) =
>>> -- do b1 <- getBounds s1
>>> --  b2 <- getBounds s2
>>> --  when (b1/=b2) (error ("\n\nWTF copySTU: "++show (b1,b2)))
>>>  ST $ \s1# ->
>>>    case sizeofMutableByteArray# msource        of { n# ->
>>>    case unsafeCoerce# memcpy mdest msource n# s1# of { (# s2#, () #) ->
>>>    (# s2#, () #) }}
>>>   
>>
>> To allow efficient copying of STUArrays.
>>  
>>
> How does this guarantee that it doesn't overflow the buffer of the
> destination array?

As is, the above is a very unsafe operation.  The check is commented out.
You can uncomment the code above that says:

>  do b1 <- getBounds s1
>     b2 <- getBounds s2
>     when (b1/=b2) (error ("\n\nWTF copySTU: "++show (b1,b2)))

Which checks the high-level boundary matches, not just the actual length.

I only have a single size of STUArray haning around, so I use the unsafe and
fast version.

-- 
Chris



More information about the Haskell-Cafe mailing list