{-# LANGUAGE CPP #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
#if __GLASGOW_HASKELL__ < 906
{-# LANGUAGE TypeInType #-}
#endif
#include "HsBaseConfig.h"
module Data.Primitive.Types
( Prim(..)
, sizeOf, alignment, defaultSetByteArray#, defaultSetOffAddr#
, PrimStorable(..)
, Ptr(..)
) where
import Control.Monad.Primitive
import Data.Primitive.MachDeps
import Data.Primitive.Internal.Operations
import Foreign.Ptr (IntPtr, intPtrToPtr, ptrToIntPtr, WordPtr, wordPtrToPtr, ptrToWordPtr)
import Foreign.C.Types
import System.Posix.Types
import GHC.Word (Word8(..), Word16(..), Word32(..), Word64(..))
import GHC.Int (Int8(..), Int16(..), Int32(..), Int64(..))
import GHC.Stable (StablePtr(..))
import GHC.Exts hiding (setByteArray#)
import Foreign.Storable (Storable)
import qualified Foreign.Storable as FS
import GHC.IO (IO(..))
import qualified GHC.Exts
import Control.Applicative (Const(..))
import Data.Functor.Identity (Identity(..))
import qualified Data.Monoid as Monoid
import qualified Data.Semigroup as Semigroup
#if !MIN_VERSION_base(4,13,0)
import Data.Ord (Down(..))
#endif
class Prim a where
sizeOf# :: a -> Int#
alignment# :: a -> Int#
indexByteArray# :: ByteArray# -> Int# -> a
readByteArray# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
writeByteArray# :: MutableByteArray# s -> Int# -> a -> State# s -> State# s
setByteArray#
:: MutableByteArray# s
-> Int#
-> Int#
-> a
-> State# s
-> State# s
indexOffAddr# :: Addr# -> Int# -> a
readOffAddr# :: Addr# -> Int# -> State# s -> (# State# s, a #)
writeOffAddr# :: Addr# -> Int# -> a -> State# s -> State# s
setOffAddr#
:: Addr#
-> Int#
-> Int#
-> a
-> State# s
-> State# s
sizeOf :: Prim a => a -> Int
sizeOf :: forall a. Prim a => a -> Int
sizeOf a
x = Int# -> Int
I# (forall a. Prim a => a -> Int#
sizeOf# a
x)
alignment :: Prim a => a -> Int
alignment :: forall a. Prim a => a -> Int
alignment a
x = Int# -> Int
I# (forall a. Prim a => a -> Int#
alignment# a
x)
defaultSetByteArray# :: Prim a => MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s
defaultSetByteArray# :: forall a s.
Prim a =>
MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s
defaultSetByteArray# MutableByteArray# s
arr# Int#
i# Int#
len# a
ident = Int# -> State# s -> State# s
go Int#
0#
where
go :: Int# -> State# s -> State# s
go Int#
ix# State# s
s0 = if Int# -> Bool
isTrue# (Int#
ix# Int# -> Int# -> Int#
<# Int#
len#)
then case forall a s.
Prim a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeByteArray# MutableByteArray# s
arr# (Int#
i# Int# -> Int# -> Int#
+# Int#
ix#) a
ident State# s
s0 of
State# s
s1 -> Int# -> State# s -> State# s
go (Int#
ix# Int# -> Int# -> Int#
+# Int#
1#) State# s
s1
else State# s
s0
defaultSetOffAddr# :: Prim a => Addr# -> Int# -> Int# -> a -> State# s -> State# s
defaultSetOffAddr# :: forall a s.
Prim a =>
Addr# -> Int# -> Int# -> a -> State# s -> State# s
defaultSetOffAddr# Addr#
addr# Int#
i# Int#
len# a
ident = forall {s}. Int# -> State# s -> State# s
go Int#
0#
where
go :: Int# -> State# s -> State# s
go Int#
ix# State# s
s0 = if Int# -> Bool
isTrue# (Int#
ix# Int# -> Int# -> Int#
<# Int#
len#)
then case forall a s. Prim a => Addr# -> Int# -> a -> State# s -> State# s
writeOffAddr# Addr#
addr# (Int#
i# Int# -> Int# -> Int#
+# Int#
ix#) a
ident State# s
s0 of
State# s
s1 -> Int# -> State# s -> State# s
go (Int#
ix# Int# -> Int# -> Int#
+# Int#
1#) State# s
s1
else State# s
s0
newtype PrimStorable a = PrimStorable { forall a. PrimStorable a -> a
getPrimStorable :: a }
instance Prim a => Storable (PrimStorable a) where
sizeOf :: PrimStorable a -> Int
sizeOf PrimStorable a
_ = forall a. Prim a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a)
alignment :: PrimStorable a -> Int
alignment PrimStorable a
_ = forall a. Prim a => a -> Int
alignment (forall a. HasCallStack => a
undefined :: a)
peekElemOff :: Ptr (PrimStorable a) -> Int -> IO (PrimStorable a)
peekElemOff (Ptr Addr#
addr#) (I# Int#
i#) =
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive forall a b. (a -> b) -> a -> b
$ \State# (PrimState IO)
s0# -> case forall a s.
Prim a =>
Addr# -> Int# -> State# s -> (# State# s, a #)
readOffAddr# Addr#
addr# Int#
i# State# (PrimState IO)
s0# of
(# State# RealWorld
s1, a
x #) -> (# State# RealWorld
s1, forall a. a -> PrimStorable a
PrimStorable a
x #)
pokeElemOff :: Ptr (PrimStorable a) -> Int -> PrimStorable a -> IO ()
pokeElemOff (Ptr Addr#
addr#) (I# Int#
i#) (PrimStorable a
a) = forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ forall a b. (a -> b) -> a -> b
$ \State# (PrimState IO)
s# ->
forall a s. Prim a => Addr# -> Int# -> a -> State# s -> State# s
writeOffAddr# Addr#
addr# Int#
i# a
a State# (PrimState IO)
s#
#define derivePrim(ty, ctr, sz, align, idx_arr, rd_arr, wr_arr, set_arr, idx_addr, rd_addr, wr_addr, set_addr) \
instance Prim (ty) where { \
sizeOf# _ = unI# sz \
; alignment# _ = unI# align \
; indexByteArray# arr# i# = ctr (idx_arr arr# i#) \
; readByteArray# arr# i# s# = case rd_arr arr# i# s# of \
{ (# s1#, x# #) -> (# s1#, ctr x# #) } \
; writeByteArray# arr# i# (ctr x#) s# = wr_arr arr# i# x# s# \
; setByteArray# arr# i# n# (ctr x#) s# \
= let { i = fromIntegral (I# i#) \
; n = fromIntegral (I# n#) \
} in \
case unsafeCoerce# (internal (set_arr arr# i n x#)) s# of \
{ (# s1#, _ #) -> s1# } \
\
; indexOffAddr# addr# i# = ctr (idx_addr addr# i#) \
; readOffAddr# addr# i# s# = case rd_addr addr# i# s# of \
{ (# s1#, x# #) -> (# s1#, ctr x# #) } \
; writeOffAddr# addr# i# (ctr x#) s# = wr_addr addr# i# x# s# \
; setOffAddr# addr# i# n# (ctr x#) s# \
= let { i = fromIntegral (I# i#) \
; n = fromIntegral (I# n#) \
} in \
case unsafeCoerce# (internal (set_addr addr# i n x#)) s# of \
{ (# s1#, _ #) -> s1# } \
; {-# INLINE sizeOf# #-} \
; {-# INLINE alignment# #-} \
; {-# INLINE indexByteArray# #-} \
; {-# INLINE readByteArray# #-} \
; {-# INLINE writeByteArray# #-} \
; {-# INLINE setByteArray# #-} \
; {-# INLINE indexOffAddr# #-} \
; {-# INLINE readOffAddr# #-} \
; {-# INLINE writeOffAddr# #-} \
; {-# INLINE setOffAddr# #-} \
}
#if __GLASGOW_HASKELL__ >= 902
liberate# :: State# s -> State# r
liberate# :: forall s r. State# s -> State# r
liberate# = unsafeCoerce# :: forall a b. a -> b
unsafeCoerce#
shimmedSetWord8Array# :: MutableByteArray# s -> Int -> Int -> Word8# -> IO ()
shimmedSetWord8Array# :: forall s. MutableByteArray# s -> Int -> Int -> Word8# -> IO ()
shimmedSetWord8Array# MutableByteArray# s
m (I# Int#
off) (I# Int#
len) Word8#
w = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (\State# RealWorld
s -> (# forall s r. State# s -> State# r
liberate# (forall d.
MutableByteArray# d -> Int# -> Int# -> Int# -> State# d -> State# d
GHC.Exts.setByteArray# MutableByteArray# s
m Int#
off Int#
len (Word# -> Int#
GHC.Exts.word2Int# (Word8# -> Word#
GHC.Exts.word8ToWord# Word8#
w)) (forall s r. State# s -> State# r
liberate# State# RealWorld
s)), () #))
shimmedSetInt8Array# :: MutableByteArray# s -> Int -> Int -> Int8# -> IO ()
shimmedSetInt8Array# :: forall s. MutableByteArray# s -> Int -> Int -> Int8# -> IO ()
shimmedSetInt8Array# MutableByteArray# s
m (I# Int#
off) (I# Int#
len) Int8#
i = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (\State# RealWorld
s -> (# forall s r. State# s -> State# r
liberate# (forall d.
MutableByteArray# d -> Int# -> Int# -> Int# -> State# d -> State# d
GHC.Exts.setByteArray# MutableByteArray# s
m Int#
off Int#
len (Int8# -> Int#
GHC.Exts.int8ToInt# Int8#
i) (forall s r. State# s -> State# r
liberate# State# RealWorld
s)), () #))
#else
liberate# :: State# s -> State# r
liberate# = unsafeCoerce#
shimmedSetWord8Array# :: MutableByteArray# s -> Int -> Int -> Word# -> IO ()
shimmedSetWord8Array# m (I# off) (I# len) w = IO (\s -> (# liberate# (GHC.Exts.setByteArray# m off len (GHC.Exts.word2Int# w) (liberate# s)), () #))
shimmedSetInt8Array# :: MutableByteArray# s -> Int -> Int -> Int# -> IO ()
shimmedSetInt8Array# m (I# off) (I# len) i = IO (\s -> (# liberate# (GHC.Exts.setByteArray# m off len i (liberate# s)), () #))
#endif
unI# :: Int -> Int#
unI# :: Int -> Int#
unI# (I# Int#
n#) = Int#
n#
derivePrim(Word, W#, sIZEOF_WORD, aLIGNMENT_WORD,
indexWordArray#, readWordArray#, writeWordArray#, setWordArray#,
indexWordOffAddr#, readWordOffAddr#, writeWordOffAddr#, setWordOffAddr#)
derivePrim(Word8, W8#, sIZEOF_WORD8, aLIGNMENT_WORD8,
indexWord8Array#, readWord8Array#, writeWord8Array#, shimmedSetWord8Array#,
indexWord8OffAddr#, readWord8OffAddr#, writeWord8OffAddr#, setWord8OffAddr#)
derivePrim(Word16, W16#, sIZEOF_WORD16, aLIGNMENT_WORD16,
indexWord16Array#, readWord16Array#, writeWord16Array#, setWord16Array#,
indexWord16OffAddr#, readWord16OffAddr#, writeWord16OffAddr#, setWord16OffAddr#)
derivePrim(Word32, W32#, sIZEOF_WORD32, aLIGNMENT_WORD32,
indexWord32Array#, readWord32Array#, writeWord32Array#, setWord32Array#,
indexWord32OffAddr#, readWord32OffAddr#, writeWord32OffAddr#, setWord32OffAddr#)
derivePrim(Word64, W64#, sIZEOF_WORD64, aLIGNMENT_WORD64,
indexWord64Array#, readWord64Array#, writeWord64Array#, setWord64Array#,
indexWord64OffAddr#, readWord64OffAddr#, writeWord64OffAddr#, setWord64OffAddr#)
derivePrim(Int, I#, sIZEOF_INT, aLIGNMENT_INT,
indexIntArray#, readIntArray#, writeIntArray#, setIntArray#,
indexIntOffAddr#, readIntOffAddr#, writeIntOffAddr#, setIntOffAddr#)
derivePrim(Int8, I8#, sIZEOF_INT8, aLIGNMENT_INT8,
indexInt8Array#, readInt8Array#, writeInt8Array#, shimmedSetInt8Array#,
indexInt8OffAddr#, readInt8OffAddr#, writeInt8OffAddr#, setInt8OffAddr#)
derivePrim(Int16, I16#, sIZEOF_INT16, aLIGNMENT_INT16,
indexInt16Array#, readInt16Array#, writeInt16Array#, setInt16Array#,
indexInt16OffAddr#, readInt16OffAddr#, writeInt16OffAddr#, setInt16OffAddr#)
derivePrim(Int32, I32#, sIZEOF_INT32, aLIGNMENT_INT32,
indexInt32Array#, readInt32Array#, writeInt32Array#, setInt32Array#,
indexInt32OffAddr#, readInt32OffAddr#, writeInt32OffAddr#, setInt32OffAddr#)
derivePrim(Int64, I64#, sIZEOF_INT64, aLIGNMENT_INT64,
indexInt64Array#, readInt64Array#, writeInt64Array#, setInt64Array#,
indexInt64OffAddr#, readInt64OffAddr#, writeInt64OffAddr#, setInt64OffAddr#)
derivePrim(Float, F#, sIZEOF_FLOAT, aLIGNMENT_FLOAT,
indexFloatArray#, readFloatArray#, writeFloatArray#, setFloatArray#,
indexFloatOffAddr#, readFloatOffAddr#, writeFloatOffAddr#, setFloatOffAddr#)
derivePrim(Double, D#, sIZEOF_DOUBLE, aLIGNMENT_DOUBLE,
indexDoubleArray#, readDoubleArray#, writeDoubleArray#, setDoubleArray#,
indexDoubleOffAddr#, readDoubleOffAddr#, writeDoubleOffAddr#, setDoubleOffAddr#)
derivePrim(Char, C#, sIZEOF_CHAR, aLIGNMENT_CHAR,
indexWideCharArray#, readWideCharArray#, writeWideCharArray#, setWideCharArray#,
indexWideCharOffAddr#, readWideCharOffAddr#, writeWideCharOffAddr#, setWideCharOffAddr#)
derivePrim(Ptr a, Ptr, sIZEOF_PTR, aLIGNMENT_PTR,
indexAddrArray#, readAddrArray#, writeAddrArray#, setAddrArray#,
indexAddrOffAddr#, readAddrOffAddr#, writeAddrOffAddr#, setAddrOffAddr#)
derivePrim(StablePtr a, StablePtr, sIZEOF_PTR, aLIGNMENT_PTR,
indexStablePtrArray#, readStablePtrArray#, writeStablePtrArray#, setStablePtrArray#,
indexStablePtrOffAddr#, readStablePtrOffAddr#, writeStablePtrOffAddr#, setStablePtrOffAddr#)
derivePrim(FunPtr a, FunPtr, sIZEOF_PTR, aLIGNMENT_PTR,
indexAddrArray#, readAddrArray#, writeAddrArray#, setAddrArray#,
indexAddrOffAddr#, readAddrOffAddr#, writeAddrOffAddr#, setAddrOffAddr#)
deriving instance Prim CChar
deriving instance Prim CSChar
deriving instance Prim CUChar
deriving instance Prim CShort
deriving instance Prim CUShort
deriving instance Prim CInt
deriving instance Prim CUInt
deriving instance Prim CLong
deriving instance Prim CULong
deriving instance Prim CPtrdiff
deriving instance Prim CSize
deriving instance Prim CWchar
deriving instance Prim CSigAtomic
deriving instance Prim CLLong
deriving instance Prim CULLong
#if MIN_VERSION_base(4,10,0)
deriving instance Prim CBool
#endif
deriving instance Prim CIntPtr
deriving instance Prim CUIntPtr
deriving instance Prim CIntMax
deriving instance Prim CUIntMax
deriving instance Prim CClock
deriving instance Prim CTime
deriving instance Prim CUSeconds
deriving instance Prim CSUSeconds
deriving instance Prim CFloat
deriving instance Prim CDouble
#if defined(HTYPE_DEV_T)
deriving instance Prim CDev
#endif
#if defined(HTYPE_INO_T)
deriving instance Prim CIno
#endif
#if defined(HTYPE_MODE_T)
deriving instance Prim CMode
#endif
#if defined(HTYPE_OFF_T)
deriving instance Prim COff
#endif
#if defined(HTYPE_PID_T)
deriving instance Prim CPid
#endif
#if defined(HTYPE_SSIZE_T)
deriving instance Prim CSsize
#endif
#if defined(HTYPE_GID_T)
deriving instance Prim CGid
#endif
#if defined(HTYPE_NLINK_T)
deriving instance Prim CNlink
#endif
#if defined(HTYPE_UID_T)
deriving instance Prim CUid
#endif
#if defined(HTYPE_CC_T)
deriving instance Prim CCc
#endif
#if defined(HTYPE_SPEED_T)
deriving instance Prim CSpeed
#endif
#if defined(HTYPE_TCFLAG_T)
deriving instance Prim CTcflag
#endif
#if defined(HTYPE_RLIM_T)
deriving instance Prim CRLim
#endif
#if defined(HTYPE_BLKSIZE_T)
deriving instance Prim CBlkSize
#endif
#if defined(HTYPE_BLKCNT_T)
deriving instance Prim CBlkCnt
#endif
#if defined(HTYPE_CLOCKID_T)
deriving instance Prim CClockId
#endif
#if defined(HTYPE_FSBLKCNT_T)
deriving instance Prim CFsBlkCnt
#endif
#if defined(HTYPE_FSFILCNT_T)
deriving instance Prim CFsFilCnt
#endif
#if defined(HTYPE_ID_T)
deriving instance Prim CId
#endif
#if defined(HTYPE_KEY_T)
deriving instance Prim CKey
#endif
#if defined(HTYPE_TIMER_T)
deriving instance Prim CTimer
#endif
deriving instance Prim Fd
instance Prim WordPtr where
sizeOf# :: WordPtr -> Int#
sizeOf# WordPtr
_ = forall a. Prim a => a -> Int#
sizeOf# (forall a. HasCallStack => a
undefined :: Ptr ())
alignment# :: WordPtr -> Int#
alignment# WordPtr
_ = forall a. Prim a => a -> Int#
alignment# (forall a. HasCallStack => a
undefined :: Ptr ())
indexByteArray# :: ByteArray# -> Int# -> WordPtr
indexByteArray# ByteArray#
a Int#
i = forall a. Ptr a -> WordPtr
ptrToWordPtr (forall a. Prim a => ByteArray# -> Int# -> a
indexByteArray# ByteArray#
a Int#
i)
readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, WordPtr #)
readByteArray# MutableByteArray# s
a Int#
i State# s
s0 = case forall a s.
Prim a =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
readByteArray# MutableByteArray# s
a Int#
i State# s
s0 of
(# State# s
s1, Ptr Any
p #) -> (# State# s
s1, forall a. Ptr a -> WordPtr
ptrToWordPtr Ptr Any
p #)
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> WordPtr -> State# s -> State# s
writeByteArray# MutableByteArray# s
a Int#
i WordPtr
wp = forall a s.
Prim a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeByteArray# MutableByteArray# s
a Int#
i (forall a. WordPtr -> Ptr a
wordPtrToPtr WordPtr
wp)
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> WordPtr -> State# s -> State# s
setByteArray# MutableByteArray# s
a Int#
i Int#
n WordPtr
wp = forall a s.
Prim a =>
MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s
setByteArray# MutableByteArray# s
a Int#
i Int#
n (forall a. WordPtr -> Ptr a
wordPtrToPtr WordPtr
wp)
indexOffAddr# :: Addr# -> Int# -> WordPtr
indexOffAddr# Addr#
a Int#
i = forall a. Ptr a -> WordPtr
ptrToWordPtr (forall a. Prim a => Addr# -> Int# -> a
indexOffAddr# Addr#
a Int#
i)
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, WordPtr #)
readOffAddr# Addr#
a Int#
i State# s
s0 = case forall a s.
Prim a =>
Addr# -> Int# -> State# s -> (# State# s, a #)
readOffAddr# Addr#
a Int#
i State# s
s0 of
(# State# s
s1, Ptr Any
p #) -> (# State# s
s1, forall a. Ptr a -> WordPtr
ptrToWordPtr Ptr Any
p #)
writeOffAddr# :: forall s. Addr# -> Int# -> WordPtr -> State# s -> State# s
writeOffAddr# Addr#
a Int#
i WordPtr
wp = forall a s. Prim a => Addr# -> Int# -> a -> State# s -> State# s
writeOffAddr# Addr#
a Int#
i (forall a. WordPtr -> Ptr a
wordPtrToPtr WordPtr
wp)
setOffAddr# :: forall s. Addr# -> Int# -> Int# -> WordPtr -> State# s -> State# s
setOffAddr# Addr#
a Int#
i Int#
n WordPtr
wp = forall a s.
Prim a =>
Addr# -> Int# -> Int# -> a -> State# s -> State# s
setOffAddr# Addr#
a Int#
i Int#
n (forall a. WordPtr -> Ptr a
wordPtrToPtr WordPtr
wp)
instance Prim IntPtr where
sizeOf# :: IntPtr -> Int#
sizeOf# IntPtr
_ = forall a. Prim a => a -> Int#
sizeOf# (forall a. HasCallStack => a
undefined :: Ptr ())
alignment# :: IntPtr -> Int#
alignment# IntPtr
_ = forall a. Prim a => a -> Int#
alignment# (forall a. HasCallStack => a
undefined :: Ptr ())
indexByteArray# :: ByteArray# -> Int# -> IntPtr
indexByteArray# ByteArray#
a Int#
i = forall a. Ptr a -> IntPtr
ptrToIntPtr (forall a. Prim a => ByteArray# -> Int# -> a
indexByteArray# ByteArray#
a Int#
i)
readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, IntPtr #)
readByteArray# MutableByteArray# s
a Int#
i State# s
s0 = case forall a s.
Prim a =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
readByteArray# MutableByteArray# s
a Int#
i State# s
s0 of
(# State# s
s1, Ptr Any
p #) -> (# State# s
s1, forall a. Ptr a -> IntPtr
ptrToIntPtr Ptr Any
p #)
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> IntPtr -> State# s -> State# s
writeByteArray# MutableByteArray# s
a Int#
i IntPtr
wp = forall a s.
Prim a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeByteArray# MutableByteArray# s
a Int#
i (forall a. IntPtr -> Ptr a
intPtrToPtr IntPtr
wp)
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> IntPtr -> State# s -> State# s
setByteArray# MutableByteArray# s
a Int#
i Int#
n IntPtr
wp = forall a s.
Prim a =>
MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s
setByteArray# MutableByteArray# s
a Int#
i Int#
n (forall a. IntPtr -> Ptr a
intPtrToPtr IntPtr
wp)
indexOffAddr# :: Addr# -> Int# -> IntPtr
indexOffAddr# Addr#
a Int#
i = forall a. Ptr a -> IntPtr
ptrToIntPtr (forall a. Prim a => Addr# -> Int# -> a
indexOffAddr# Addr#
a Int#
i)
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, IntPtr #)
readOffAddr# Addr#
a Int#
i State# s
s0 = case forall a s.
Prim a =>
Addr# -> Int# -> State# s -> (# State# s, a #)
readOffAddr# Addr#
a Int#
i State# s
s0 of
(# State# s
s1, Ptr Any
p #) -> (# State# s
s1, forall a. Ptr a -> IntPtr
ptrToIntPtr Ptr Any
p #)
writeOffAddr# :: forall s. Addr# -> Int# -> IntPtr -> State# s -> State# s
writeOffAddr# Addr#
a Int#
i IntPtr
wp = forall a s. Prim a => Addr# -> Int# -> a -> State# s -> State# s
writeOffAddr# Addr#
a Int#
i (forall a. IntPtr -> Ptr a
intPtrToPtr IntPtr
wp)
setOffAddr# :: forall s. Addr# -> Int# -> Int# -> IntPtr -> State# s -> State# s
setOffAddr# Addr#
a Int#
i Int#
n IntPtr
wp = forall a s.
Prim a =>
Addr# -> Int# -> Int# -> a -> State# s -> State# s
setOffAddr# Addr#
a Int#
i Int#
n (forall a. IntPtr -> Ptr a
intPtrToPtr IntPtr
wp)
deriving instance Prim a => Prim (Const a b)
deriving instance Prim a => Prim (Down a)
deriving instance Prim a => Prim (Identity a)
deriving instance Prim a => Prim (Monoid.Dual a)
deriving instance Prim a => Prim (Monoid.Sum a)
deriving instance Prim a => Prim (Monoid.Product a)
deriving instance Prim a => Prim (Semigroup.First a)
deriving instance Prim a => Prim (Semigroup.Last a)
deriving instance Prim a => Prim (Semigroup.Min a)
deriving instance Prim a => Prim (Semigroup.Max a)