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    , Word(..)
19    ) where
20
21import qualified Prelude
22import           GHC.Exts
23import           GHC.Prim
24import           GHC.Word
25import           GHC.IO
26
27import           Basement.Compat.PrimTypes
28
29--  GHC 8.8  | Base 4.13
30--  GHC 8.6  | Base 4.12
31--  GHC 8.4  | Base 4.11
32--  GHC 8.2  | Base 4.10
33--  GHC 8.0  | Base 4.9
34--  GHC 7.10 | Base 4.8
35--  GHC 7.8  | Base 4.7
36--  GHC 7.6  | Base 4.6
37--  GHC 7.4  | Base 4.5
38--
39--  More complete list:
40--  https://wiki.haskell.org/Base_package
41
42-- | Flag record whether a specific byte array is pinned or not
43data PinnedStatus = Pinned | Unpinned
44    deriving (Prelude.Eq)
45
46toPinnedStatus# :: Pinned# -> PinnedStatus
47toPinnedStatus# 0# = Unpinned
48toPinnedStatus# _  = Pinned
49
50-- | turn an Int# into a Bool
51bool# :: Int# -> Prelude.Bool
52bool# v = isTrue# v
53{-# INLINE bool# #-}
54
55-- | A mkWeak# version that keep working on 8.0
56--
57-- signature change in ghc-prim:
58-- * 0.4: mkWeak# :: o -> b -> c                                             -> State# RealWorld -> (#State# RealWorld, Weak# b#)
59-- * 0.5 :mkWeak# :: o -> b -> (State# RealWorld -> (#State# RealWorld, c#)) -> State# RealWorld -> (#State# RealWorld, Weak# b#)
60--
61compatMkWeak# :: o -> b -> Prelude.IO () -> State# RealWorld -> (#State# RealWorld, Weak# b #)
62compatMkWeak# o b c s = mkWeak# o b (case c of { IO f -> f }) s
63{-# INLINE compatMkWeak# #-}
64
65#if __GLASGOW_HASKELL__ >= 802
66compatIsByteArrayPinned# :: ByteArray# -> Pinned#
67compatIsByteArrayPinned# ba = isByteArrayPinned# ba
68
69compatIsMutableByteArrayPinned# :: MutableByteArray# s -> Pinned#
70compatIsMutableByteArrayPinned# ba = isMutableByteArrayPinned# ba
71#else
72foreign import ccall unsafe "basement_is_bytearray_pinned"
73    compatIsByteArrayPinned# :: ByteArray# -> Pinned#
74
75foreign import ccall unsafe "basement_is_bytearray_pinned"
76    compatIsMutableByteArrayPinned# :: MutableByteArray# s -> Pinned#
77#endif
78