1-- |
2-- Module      : Basement.Compat.Primitive
3-- License     : BSD-style
4-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
5-- Stability   : experimental
6-- Portability : portable
7--
8{-# LANGUAGE MagicHash #-}
9{-# LANGUAGE UnboxedTuples #-}
10{-# LANGUAGE CPP #-}
11{-# LANGUAGE UnliftedFFITypes #-}
12module Basement.Compat.Primitive
13    ( bool#
14    , PinnedStatus(..), toPinnedStatus#
15    , compatMkWeak#
16    , compatIsByteArrayPinned#
17    , compatIsMutableByteArrayPinned#
18    , unsafeCoerce#
19    , Word(..)
20    ) where
21
22import qualified Prelude
23import           GHC.Exts
24import           GHC.Prim
25import           GHC.Word
26import           GHC.IO
27
28import           Basement.Compat.PrimTypes
29
30--  GHC 9.0  | Base 4.15
31--  GHC 8.8  | Base 4.13 4.14
32--  GHC 8.6  | Base 4.12
33--  GHC 8.4  | Base 4.11
34--  GHC 8.2  | Base 4.10
35--  GHC 8.0  | Base 4.9
36--  GHC 7.10 | Base 4.8
37--  GHC 7.8  | Base 4.7
38--  GHC 7.6  | Base 4.6
39--  GHC 7.4  | Base 4.5
40--
41--  More complete list:
42--  https://wiki.haskell.org/Base_package
43
44-- | Flag record whether a specific byte array is pinned or not
45data PinnedStatus = Pinned | Unpinned
46    deriving (Prelude.Eq)
47
48toPinnedStatus# :: Pinned# -> PinnedStatus
49toPinnedStatus# 0# = Unpinned
50toPinnedStatus# _  = Pinned
51
52-- | turn an Int# into a Bool
53bool# :: Int# -> Prelude.Bool
54bool# v = isTrue# v
55{-# INLINE bool# #-}
56
57-- | A mkWeak# version that keep working on 8.0
58--
59-- signature change in ghc-prim:
60-- * 0.4: mkWeak# :: o -> b -> c                                             -> State# RealWorld -> (#State# RealWorld, Weak# b#)
61-- * 0.5 :mkWeak# :: o -> b -> (State# RealWorld -> (#State# RealWorld, c#)) -> State# RealWorld -> (#State# RealWorld, Weak# b#)
62--
63compatMkWeak# :: o -> b -> Prelude.IO () -> State# RealWorld -> (#State# RealWorld, Weak# b #)
64compatMkWeak# o b c s = mkWeak# o b (case c of { IO f -> f }) s
65{-# INLINE compatMkWeak# #-}
66
67#if __GLASGOW_HASKELL__ >= 802
68compatIsByteArrayPinned# :: ByteArray# -> Pinned#
69compatIsByteArrayPinned# ba = isByteArrayPinned# ba
70
71compatIsMutableByteArrayPinned# :: MutableByteArray# s -> Pinned#
72compatIsMutableByteArrayPinned# ba = isMutableByteArrayPinned# ba
73#else
74foreign import ccall unsafe "basement_is_bytearray_pinned"
75    compatIsByteArrayPinned# :: ByteArray# -> Pinned#
76
77foreign import ccall unsafe "basement_is_bytearray_pinned"
78    compatIsMutableByteArrayPinned# :: MutableByteArray# s -> Pinned#
79#endif
80