Skip to content

Commit

Permalink
Use copyMutableByteArray# in moveByteArray
Browse files Browse the repository at this point in the history
The primop in question appears to have always been safe for
use with overlapping ranges since its introduction. See also:
https://gitlab.haskell.org/ghc/ghc/-/commit/b00b36196a88ad6b9054244caaec926f6f9db2cf

The cbits function "hsprimitive_memmove" is now unused,
but is not removed because it was arguably publicly exposed
due to the "Install-Includes: primitive-memops.h".
  • Loading branch information
clyring authored and andrewthad committed Jan 5, 2024
1 parent 5f99571 commit 06b1c86
Showing 1 changed file with 2 additions and 9 deletions.
11 changes: 2 additions & 9 deletions Data/Primitive/ByteArray.hs
Original file line number Diff line number Diff line change
Expand Up @@ -79,7 +79,6 @@ import Data.Proxy
import qualified GHC.ST as GHCST
#endif

import Foreign.C.Types
import Data.Word ( Word8 )
#if __GLASGOW_HASKELL__ >= 802
import qualified GHC.Exts as Exts
Expand All @@ -88,6 +87,7 @@ import GHC.Exts hiding (setByteArray#)
import GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents(..))

#if __GLASGOW_HASKELL__ < 804
import Foreign.C.Types
import System.IO.Unsafe (unsafeDupablePerformIO)
#endif

Expand Down Expand Up @@ -540,9 +540,7 @@ moveByteArray
{-# INLINE moveByteArray #-}
moveByteArray (MutableByteArray dst#) doff
(MutableByteArray src#) soff sz
= unsafePrimToPrim
$ memmove_mba dst# (fromIntegral doff) src# (fromIntegral soff)
(fromIntegral sz)
= primitive_ (copyMutableByteArray# src# (unI# soff) dst# (unI# doff) (unI# sz))

-- | Fill a slice of a mutable byte array with a value. The offset and length
-- are given in elements of type @a@ rather than in bytes.
Expand Down Expand Up @@ -572,11 +570,6 @@ fillByteArray
{-# INLINE fillByteArray #-}
fillByteArray = setByteArray

foreign import ccall unsafe "primitive-memops.h hsprimitive_memmove"
memmove_mba :: MutableByteArray# s -> CPtrdiff
-> MutableByteArray# s -> CPtrdiff
-> CSize -> IO ()

-- | Lexicographic comparison of equal-length slices into two byte arrays.
-- This wraps the @compareByteArrays#@ primop, which wraps @memcmp@.
compareByteArrays
Expand Down

0 comments on commit 06b1c86

Please sign in to comment.