module Basement.Compat.Primitive
( bool#
, PinnedStatus(..), toPinnedStatus#
, compatAndI#
, compatQuotRemInt#
, compatCopyAddrToByteArray#
, compatCopyByteArrayToAddr#
, compatMkWeak#
, compatGetSizeofMutableByteArray#
, compatShrinkMutableByteArray#
, compatResizeMutableByteArray#
, compatIsByteArrayPinned#
, compatIsMutableByteArrayPinned#
, Word(..)
) where
import qualified Prelude
import GHC.Exts
import GHC.Prim
import GHC.Word
#if __GLASGOW_HASKELL__ >= 800
import GHC.IO
#endif
import Basement.Compat.PrimTypes
data PinnedStatus = Pinned | Unpinned
deriving (Prelude.Eq)
toPinnedStatus# :: Pinned# -> PinnedStatus
toPinnedStatus# 0# = Unpinned
toPinnedStatus# _ = Pinned
#if MIN_VERSION_base(4,7,0)
bool# :: Int# -> Prelude.Bool
bool# v = isTrue# v
#else
bool# :: Prelude.Bool -> Prelude.Bool
bool# v = v
#endif
compatAndI# :: Int# -> Int# -> Int#
#if !MIN_VERSION_base(4,7,0)
compatAndI# a b = word2Int# (and# (int2Word# a) (int2Word# b))
#else
compatAndI# = andI#
#endif
compatQuotRemInt# :: Int# -> Int# -> (# Int#, Int# #)
compatQuotRemInt# = quotRemInt#
compatCopyAddrToByteArray# :: Addr# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
#if MIN_VERSION_base(4,7,0)
compatCopyAddrToByteArray# = copyAddrToByteArray#
#else
compatCopyAddrToByteArray# addr ba ofs sz stini =
loop ofs 0# stini
where
loop o i st
| bool# (i ==# sz) = st
| Prelude.otherwise =
case readWord8OffAddr# addr i st of
(# st2, w #) -> loop (o +# 1#) (i +# 1#) (writeWord8Array# ba o w st2)
#endif
compatCopyByteArrayToAddr# :: ByteArray# -> Int# -> Addr# -> Int# -> State# s -> State# s
#if MIN_VERSION_base(4,7,0)
compatCopyByteArrayToAddr# = copyByteArrayToAddr#
#else
compatCopyByteArrayToAddr# ba ofs addr sz stini =
loop ofs 0# stini
where
loop o i st
| bool# (i ==# sz) = st
| Prelude.otherwise =
loop (o +# 1#) (i +# 1#) (writeWord8OffAddr# addr i (indexWord8Array# ba o) st)
#endif
compatMkWeak# :: o -> b -> Prelude.IO () -> State# RealWorld -> (#State# RealWorld, Weak# b #)
#if __GLASGOW_HASKELL__ >= 800
compatMkWeak# o b c s = mkWeak# o b (case c of { IO f -> f }) s
#else
compatMkWeak# o b c s = mkWeak# o b c s
#endif
compatGetSizeofMutableByteArray# :: MutableByteArray# s -> State# s -> (#State# s, Int# #)
#if __GLASGOW_HASKELL__ >= 800
compatGetSizeofMutableByteArray# mba s = getSizeofMutableByteArray# mba s
#else
compatGetSizeofMutableByteArray# mba s = (# s, sizeofMutableByteArray# mba #)
#endif
compatShrinkMutableByteArray# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
#if __GLASGOW_HASKELL__ >= 800
compatShrinkMutableByteArray# mba i s =
case shrinkMutableByteArray# mba i s of { s2 -> (# s2, mba #) }
#else
compatShrinkMutableByteArray# src i s =
case newAlignedPinnedByteArray# i 8# s of { (# s2, dst #) ->
case copyMutableByteArray# src 0# dst 0# i s2 of { s3 -> (# s3, dst #) }}
#endif
compatResizeMutableByteArray# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
#if __GLASGOW_HASKELL__ >= 800
compatResizeMutableByteArray# mba i s = resizeMutableByteArray# mba i s
#else
compatResizeMutableByteArray# src i s =
case newAlignedPinnedByteArray# i 8# s of { (# s2, dst #) ->
case copyMutableByteArray# src 0# dst 0# nbBytes s2 of { s3 -> (# s3, dst #) }}
where
isGrow = bool# (i ># len)
nbBytes
| isGrow = len
| Prelude.otherwise = i
!len = sizeofMutableByteArray# src
#endif
#if __GLASGOW_HASKELL__ >= 802
compatIsByteArrayPinned# :: ByteArray# -> Pinned#
compatIsByteArrayPinned# ba = isByteArrayPinned# ba
compatIsMutableByteArrayPinned# :: MutableByteArray# s -> Pinned#
compatIsMutableByteArrayPinned# ba = isMutableByteArrayPinned# ba
#else
foreign import ccall unsafe "foundation_is_bytearray_pinned"
compatIsByteArrayPinned# :: ByteArray# -> Pinned#
foreign import ccall unsafe "foundation_is_bytearray_pinned"
compatIsMutableByteArrayPinned# :: MutableByteArray# s -> Pinned#
#endif