-- |
-- Module      : Basement.Compat.Primitive
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : portable
--
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE UnliftedFFITypes #-}
module Basement.Compat.Primitive
    ( bool#
    , PinnedStatus(..), toPinnedStatus#
    , compatMkWeak#
    , compatIsByteArrayPinned#
    , compatIsMutableByteArrayPinned#
    , unsafeCoerce#
    , Word(..)
    ) where

import qualified Prelude
import           GHC.Exts
import           GHC.Prim
import           GHC.Word
import           GHC.IO

import           Basement.Compat.PrimTypes

--  GHC 9.0  | Base 4.15
--  GHC 8.8  | Base 4.13 4.14
--  GHC 8.6  | Base 4.12
--  GHC 8.4  | Base 4.11
--  GHC 8.2  | Base 4.10
--  GHC 8.0  | Base 4.9
--  GHC 7.10 | Base 4.8
--  GHC 7.8  | Base 4.7
--  GHC 7.6  | Base 4.6
--  GHC 7.4  | Base 4.5
--
--  More complete list:
--  https://wiki.haskell.org/Base_package

-- | Flag record whether a specific byte array is pinned or not
data PinnedStatus = Pinned | Unpinned
    deriving (PinnedStatus -> PinnedStatus -> Bool
(PinnedStatus -> PinnedStatus -> Bool)
-> (PinnedStatus -> PinnedStatus -> Bool) -> Eq PinnedStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PinnedStatus -> PinnedStatus -> Bool
$c/= :: PinnedStatus -> PinnedStatus -> Bool
== :: PinnedStatus -> PinnedStatus -> Bool
$c== :: PinnedStatus -> PinnedStatus -> Bool
Prelude.Eq)

toPinnedStatus# :: Pinned# -> PinnedStatus
toPinnedStatus# :: Pinned# -> PinnedStatus
toPinnedStatus# Pinned#
0# = PinnedStatus
Unpinned
toPinnedStatus# Pinned#
_  = PinnedStatus
Pinned

-- | turn an Int# into a Bool
bool# :: Int# -> Prelude.Bool
bool# :: Pinned# -> Bool
bool# Pinned#
v = Pinned# -> Bool
isTrue# Pinned#
v
{-# INLINE bool# #-}

-- | A mkWeak# version that keep working on 8.0
--
-- signature change in ghc-prim:
-- * 0.4: mkWeak# :: o -> b -> c                                             -> State# RealWorld -> (#State# RealWorld, Weak# b#)
-- * 0.5 :mkWeak# :: o -> b -> (State# RealWorld -> (#State# RealWorld, c#)) -> State# RealWorld -> (#State# RealWorld, Weak# b#)
--
compatMkWeak# :: o -> b -> Prelude.IO () -> State# RealWorld -> (#State# RealWorld, Weak# b #)
compatMkWeak# :: o
-> b
-> IO ()
-> State# RealWorld
-> (# State# RealWorld, Weak# b #)
compatMkWeak# o
o b
b IO ()
c State# RealWorld
s = o
-> b
-> (State# RealWorld -> (# State# RealWorld, () #))
-> State# RealWorld
-> (# State# RealWorld, Weak# b #)
forall a b c.
a
-> b
-> (State# RealWorld -> (# State# RealWorld, c #))
-> State# RealWorld
-> (# State# RealWorld, Weak# b #)
mkWeak# o
o b
b (case IO ()
c of { IO State# RealWorld -> (# State# RealWorld, () #)
f -> State# RealWorld -> (# State# RealWorld, () #)
f }) State# RealWorld
s
{-# INLINE compatMkWeak# #-}

#if __GLASGOW_HASKELL__ >= 802
compatIsByteArrayPinned# :: ByteArray# -> Pinned#
compatIsByteArrayPinned# :: ByteArray# -> Pinned#
compatIsByteArrayPinned# ByteArray#
ba = ByteArray# -> Pinned#
isByteArrayPinned# ByteArray#
ba

compatIsMutableByteArrayPinned# :: MutableByteArray# s -> Pinned#
compatIsMutableByteArrayPinned# :: MutableByteArray# s -> Pinned#
compatIsMutableByteArrayPinned# MutableByteArray# s
ba = MutableByteArray# s -> Pinned#
forall d. MutableByteArray# d -> Pinned#
isMutableByteArrayPinned# MutableByteArray# s
ba
#else
foreign import ccall unsafe "basement_is_bytearray_pinned"
    compatIsByteArrayPinned# :: ByteArray# -> Pinned#

foreign import ccall unsafe "basement_is_bytearray_pinned"
    compatIsMutableByteArrayPinned# :: MutableByteArray# s -> Pinned#
#endif