module Foundation.Primitive.Types
( PrimType(..)
, primBaIndex
, primMbaRead
, primMbaWrite
, primArrayIndex
, primMutableArrayRead
, primMutableArrayWrite
, primOffsetOfE
, primOffsetRecast
, sizeRecast
, offsetAsSize
, sizeAsOffset
, primWordGetByteAndShift
, primWord64GetByteAndShift
, primWord64GetHiLo
) where
#include "MachDeps.h"
import GHC.Prim
import GHC.Int
import GHC.Types
import GHC.Word
import Foreign.C.Types
import Foundation.Internal.Proxy
import Foundation.Internal.Base
import Foundation.Primitive.Types.OffsetSize
import Foundation.Primitive.Endianness
import Foundation.Primitive.Monad
import qualified Prelude (quot)
#if WORD_SIZE_IN_BITS < 64
import GHC.IntWord64
#endif
#ifdef FOUNDATION_BOUNDS_CHECK
divBytes :: PrimType ty => Offset ty -> (Int -> Int)
divBytes ofs = \x -> x `Prelude.quot` (getSize Proxy ofs)
where
getSize :: PrimType ty => Proxy ty -> Offset ty -> Int
getSize p _ = let (Size sz) = primSizeInBytes p in sz
baLength :: PrimType ty => Offset ty -> ByteArray# -> Int
baLength ofs ba = divBytes ofs (I# (sizeofByteArray# ba))
mbaLength :: PrimType ty => Offset ty -> MutableByteArray# st -> Int
mbaLength ofs ba = divBytes ofs (I# (sizeofMutableByteArray# ba))
aLength :: Array# ty -> Int
aLength ba = I# (sizeofArray# ba)
maLength :: MutableArray# st ty -> Int
maLength ba = I# (sizeofMutableArray# ba)
boundCheckError :: [Char] -> Offset ty -> Int -> a
boundCheckError ty (Offset ofs) len =
error (ty <> " offset=" <> show ofs <> " len=" <> show len)
baCheck :: PrimType ty => ByteArray# -> Offset ty -> Bool
baCheck ba ofs@(Offset o) = o < 0 || o >= baLength ofs ba
mbaCheck :: PrimType ty => MutableByteArray# st -> Offset ty -> Bool
mbaCheck mba ofs@(Offset o) = o < 0 || o >= mbaLength ofs mba
aCheck :: Array# ty -> Offset ty -> Bool
aCheck ba (Offset o) = o < 0 || o >= aLength ba
maCheck :: MutableArray# st ty -> Offset ty -> Bool
maCheck ma (Offset o) = o < 0 || o >= maLength ma
primBaIndex :: PrimType ty => ByteArray# -> Offset ty -> ty
primBaIndex ba ofs
| baCheck ba ofs = boundCheckError "bytearray-index" ofs (baLength ofs ba)
| otherwise = primBaUIndex ba ofs
primMbaRead :: (PrimType ty, PrimMonad prim) => MutableByteArray# (PrimState prim) -> Offset ty -> prim ty
primMbaRead mba ofs
| mbaCheck mba ofs = boundCheckError "mutablebytearray-read" ofs (mbaLength ofs mba)
| otherwise = primMbaURead mba ofs
primMbaWrite :: (PrimType ty, PrimMonad prim) => MutableByteArray# (PrimState prim) -> Offset ty -> ty -> prim ()
primMbaWrite mba ofs ty
| mbaCheck mba ofs = boundCheckError "mutablebytearray-write" ofs (mbaLength ofs mba)
| otherwise = primMbaUWrite mba ofs ty
primArrayIndex :: Array# ty -> Offset ty -> ty
primArrayIndex a o@(Offset (I# ofs))
| aCheck a o = boundCheckError "array-index" o (aLength a)
| otherwise = let (# v #) = indexArray# a ofs in v
primMutableArrayRead :: PrimMonad prim => MutableArray# (PrimState prim) ty -> Offset ty -> prim ty
primMutableArrayRead ma o@(Offset (I# ofs))
| maCheck ma o = boundCheckError "array-read" o (maLength ma)
| otherwise = primitive $ \s1 -> readArray# ma ofs s1
primMutableArrayWrite :: PrimMonad prim => MutableArray# (PrimState prim) ty -> Offset ty -> ty -> prim ()
primMutableArrayWrite ma o@(Offset (I# ofs)) v
| maCheck ma o = boundCheckError "array-write" o (maLength ma)
| otherwise = primitive $ \s1 -> let !s2 = writeArray# ma ofs v s1 in (# s2, () #)
#else
primBaIndex :: PrimType ty => ByteArray# -> Offset ty -> ty
primBaIndex = primBaUIndex
primMbaRead :: (PrimType ty, PrimMonad prim) => MutableByteArray# (PrimState prim) -> Offset ty -> prim ty
primMbaRead = primMbaURead
primMbaWrite :: (PrimType ty, PrimMonad prim) => MutableByteArray# (PrimState prim) -> Offset ty -> ty -> prim ()
primMbaWrite = primMbaUWrite
primArrayIndex :: Array# ty -> Offset ty -> ty
primArrayIndex a (Offset (I# ofs)) = let (# v #) = indexArray# a ofs in v
primMutableArrayRead :: PrimMonad prim => MutableArray# (PrimState prim) ty -> Offset ty -> prim ty
primMutableArrayRead ma (Offset (I# ofs)) = primitive $ \s1 -> readArray# ma ofs s1
primMutableArrayWrite :: PrimMonad prim => MutableArray# (PrimState prim) ty -> Offset ty -> ty -> prim ()
primMutableArrayWrite ma (Offset (I# ofs)) v =
primitive $ \s1 -> let !s2 = writeArray# ma ofs v s1 in (# s2, () #)
#endif
class Eq ty => PrimType ty where
primSizeInBytes :: Proxy ty -> Size8
primBaUIndex :: ByteArray# -> Offset ty -> ty
primMbaURead :: PrimMonad prim
=> MutableByteArray# (PrimState prim)
-> Offset ty
-> prim ty
primMbaUWrite :: PrimMonad prim
=> MutableByteArray# (PrimState prim)
-> Offset ty
-> ty
-> prim ()
primAddrIndex :: Addr# -> Offset ty -> ty
primAddrRead :: PrimMonad prim
=> Addr#
-> Offset ty
-> prim ty
primAddrWrite :: PrimMonad prim
=> Addr#
-> Offset ty
-> ty
-> prim ()
sizeInt, sizeWord :: Size Word8
#if WORD_SIZE_IN_BITS == 64
sizeInt = Size 8
sizeWord = Size 8
#else
sizeInt = Size 4
sizeWord = Size 4
#endif
instance PrimType Int where
primSizeInBytes _ = sizeInt
primBaUIndex ba (Offset (I# n)) = I# (indexIntArray# ba n)
primMbaURead mba (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readIntArray# mba n s1 in (# s2, I# r #)
primMbaUWrite mba (Offset (I# n)) (I# w) = primitive $ \s1 -> (# writeIntArray# mba n w s1, () #)
primAddrIndex addr (Offset (I# n)) = I# (indexIntOffAddr# addr n)
primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readIntOffAddr# addr n s1 in (# s2, I# r #)
primAddrWrite addr (Offset (I# n)) (I# w) = primitive $ \s1 -> (# writeIntOffAddr# addr n w s1, () #)
instance PrimType Word where
primSizeInBytes _ = sizeWord
primBaUIndex ba (Offset (I# n)) = W# (indexWordArray# ba n)
primMbaURead mba (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readWordArray# mba n s1 in (# s2, W# r #)
primMbaUWrite mba (Offset (I# n)) (W# w) = primitive $ \s1 -> (# writeWordArray# mba n w s1, () #)
primAddrIndex addr (Offset (I# n)) = W# (indexWordOffAddr# addr n)
primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readWordOffAddr# addr n s1 in (# s2, W# r #)
primAddrWrite addr (Offset (I# n)) (W# w) = primitive $ \s1 -> (# writeWordOffAddr# addr n w s1, () #)
instance PrimType Word8 where
primSizeInBytes _ = Size 1
primBaUIndex ba (Offset (I# n)) = W8# (indexWord8Array# ba n)
primMbaURead mba (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readWord8Array# mba n s1 in (# s2, W8# r #)
primMbaUWrite mba (Offset (I# n)) (W8# w) = primitive $ \s1 -> (# writeWord8Array# mba n w s1, () #)
primAddrIndex addr (Offset (I# n)) = W8# (indexWord8OffAddr# addr n)
primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readWord8OffAddr# addr n s1 in (# s2, W8# r #)
primAddrWrite addr (Offset (I# n)) (W8# w) = primitive $ \s1 -> (# writeWord8OffAddr# addr n w s1, () #)
instance PrimType Word16 where
primSizeInBytes _ = Size 2
primBaUIndex ba (Offset (I# n)) = W16# (indexWord16Array# ba n)
primMbaURead mba (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readWord16Array# mba n s1 in (# s2, W16# r #)
primMbaUWrite mba (Offset (I# n)) (W16# w) = primitive $ \s1 -> (# writeWord16Array# mba n w s1, () #)
primAddrIndex addr (Offset (I# n)) = W16# (indexWord16OffAddr# addr n)
primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readWord16OffAddr# addr n s1 in (# s2, W16# r #)
primAddrWrite addr (Offset (I# n)) (W16# w) = primitive $ \s1 -> (# writeWord16OffAddr# addr n w s1, () #)
instance PrimType Word32 where
primSizeInBytes _ = Size 4
primBaUIndex ba (Offset (I# n)) = W32# (indexWord32Array# ba n)
primMbaURead mba (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readWord32Array# mba n s1 in (# s2, W32# r #)
primMbaUWrite mba (Offset (I# n)) (W32# w) = primitive $ \s1 -> (# writeWord32Array# mba n w s1, () #)
primAddrIndex addr (Offset (I# n)) = W32# (indexWord32OffAddr# addr n)
primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readWord32OffAddr# addr n s1 in (# s2, W32# r #)
primAddrWrite addr (Offset (I# n)) (W32# w) = primitive $ \s1 -> (# writeWord32OffAddr# addr n w s1, () #)
instance PrimType Word64 where
primSizeInBytes _ = Size 8
primBaUIndex ba (Offset (I# n)) = W64# (indexWord64Array# ba n)
primMbaURead mba (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readWord64Array# mba n s1 in (# s2, W64# r #)
primMbaUWrite mba (Offset (I# n)) (W64# w) = primitive $ \s1 -> (# writeWord64Array# mba n w s1, () #)
primAddrIndex addr (Offset (I# n)) = W64# (indexWord64OffAddr# addr n)
primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readWord64OffAddr# addr n s1 in (# s2, W64# r #)
primAddrWrite addr (Offset (I# n)) (W64# w) = primitive $ \s1 -> (# writeWord64OffAddr# addr n w s1, () #)
instance PrimType Int8 where
primSizeInBytes _ = Size 1
primBaUIndex ba (Offset (I# n)) = I8# (indexInt8Array# ba n)
primMbaURead mba (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readInt8Array# mba n s1 in (# s2, I8# r #)
primMbaUWrite mba (Offset (I# n)) (I8# w) = primitive $ \s1 -> (# writeInt8Array# mba n w s1, () #)
primAddrIndex addr (Offset (I# n)) = I8# (indexInt8OffAddr# addr n)
primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readInt8OffAddr# addr n s1 in (# s2, I8# r #)
primAddrWrite addr (Offset (I# n)) (I8# w) = primitive $ \s1 -> (# writeInt8OffAddr# addr n w s1, () #)
instance PrimType Int16 where
primSizeInBytes _ = Size 2
primBaUIndex ba (Offset (I# n)) = I16# (indexInt16Array# ba n)
primMbaURead mba (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readInt16Array# mba n s1 in (# s2, I16# r #)
primMbaUWrite mba (Offset (I# n)) (I16# w) = primitive $ \s1 -> (# writeInt16Array# mba n w s1, () #)
primAddrIndex addr (Offset (I# n)) = I16# (indexInt16OffAddr# addr n)
primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readInt16OffAddr# addr n s1 in (# s2, I16# r #)
primAddrWrite addr (Offset (I# n)) (I16# w) = primitive $ \s1 -> (# writeInt16OffAddr# addr n w s1, () #)
instance PrimType Int32 where
primSizeInBytes _ = Size 4
primBaUIndex ba (Offset (I# n)) = I32# (indexInt32Array# ba n)
primMbaURead mba (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readInt32Array# mba n s1 in (# s2, I32# r #)
primMbaUWrite mba (Offset (I# n)) (I32# w) = primitive $ \s1 -> (# writeInt32Array# mba n w s1, () #)
primAddrIndex addr (Offset (I# n)) = I32# (indexInt32OffAddr# addr n)
primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readInt32OffAddr# addr n s1 in (# s2, I32# r #)
primAddrWrite addr (Offset (I# n)) (I32# w) = primitive $ \s1 -> (# writeInt32OffAddr# addr n w s1, () #)
instance PrimType Int64 where
primSizeInBytes _ = Size 8
primBaUIndex ba (Offset (I# n)) = I64# (indexInt64Array# ba n)
primMbaURead mba (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readInt64Array# mba n s1 in (# s2, I64# r #)
primMbaUWrite mba (Offset (I# n)) (I64# w) = primitive $ \s1 -> (# writeInt64Array# mba n w s1, () #)
primAddrIndex addr (Offset (I# n)) = I64# (indexInt64OffAddr# addr n)
primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readInt64OffAddr# addr n s1 in (# s2, I64# r #)
primAddrWrite addr (Offset (I# n)) (I64# w) = primitive $ \s1 -> (# writeInt64OffAddr# addr n w s1, () #)
instance PrimType Float where
primSizeInBytes _ = Size 4
primBaUIndex ba (Offset (I# n)) = F# (indexFloatArray# ba n)
primMbaURead mba (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readFloatArray# mba n s1 in (# s2, F# r #)
primMbaUWrite mba (Offset (I# n)) (F# w) = primitive $ \s1 -> (# writeFloatArray# mba n w s1, () #)
primAddrIndex addr (Offset (I# n)) = F# (indexFloatOffAddr# addr n)
primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readFloatOffAddr# addr n s1 in (# s2, F# r #)
primAddrWrite addr (Offset (I# n)) (F# w) = primitive $ \s1 -> (# writeFloatOffAddr# addr n w s1, () #)
instance PrimType Double where
primSizeInBytes _ = Size 8
primBaUIndex ba (Offset (I# n)) = D# (indexDoubleArray# ba n)
primMbaURead mba (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readDoubleArray# mba n s1 in (# s2, D# r #)
primMbaUWrite mba (Offset (I# n)) (D# w) = primitive $ \s1 -> (# writeDoubleArray# mba n w s1, () #)
primAddrIndex addr (Offset (I# n)) = D# (indexDoubleOffAddr# addr n)
primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readDoubleOffAddr# addr n s1 in (# s2, D# r #)
primAddrWrite addr (Offset (I# n)) (D# w) = primitive $ \s1 -> (# writeDoubleOffAddr# addr n w s1, () #)
instance PrimType Char where
primSizeInBytes _ = Size 4
primBaUIndex ba (Offset (I# n)) = C# (indexWideCharArray# ba n)
primMbaURead mba (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readWideCharArray# mba n s1 in (# s2, C# r #)
primMbaUWrite mba (Offset (I# n)) (C# w) = primitive $ \s1 -> (# writeWideCharArray# mba n w s1, () #)
primAddrIndex addr (Offset (I# n)) = C# (indexWideCharOffAddr# addr n)
primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readWideCharOffAddr# addr n s1 in (# s2, C# r #)
primAddrWrite addr (Offset (I# n)) (C# w) = primitive $ \s1 -> (# writeWideCharOffAddr# addr n w s1, () #)
instance PrimType CChar where
primSizeInBytes _ = Size 1
primBaUIndex ba (Offset n) = CChar (primBaUIndex ba (Offset n))
primMbaURead mba (Offset n) = CChar <$> primMbaURead mba (Offset n)
primMbaUWrite mba (Offset n) (CChar int8) = primMbaUWrite mba (Offset n) int8
primAddrIndex addr (Offset n) = CChar $ primAddrIndex addr (Offset n)
primAddrRead addr (Offset n) = CChar <$> primAddrRead addr (Offset n)
primAddrWrite addr (Offset n) (CChar int8) = primAddrWrite addr (Offset n) int8
instance PrimType CUChar where
primSizeInBytes _ = Size 1
primBaUIndex ba (Offset n) = CUChar (primBaUIndex ba (Offset n :: Offset Word8))
primMbaURead mba (Offset n) = CUChar <$> primMbaURead mba (Offset n :: Offset Word8)
primMbaUWrite mba (Offset n) (CUChar w8) = primMbaUWrite mba (Offset n) w8
primAddrIndex addr (Offset n) = CUChar $ primAddrIndex addr (Offset n :: Offset Word8)
primAddrRead addr (Offset n) = CUChar <$> primAddrRead addr (Offset n :: Offset Word8)
primAddrWrite addr (Offset n) (CUChar w8) = primAddrWrite addr (Offset n) w8
instance PrimType a => PrimType (LE a) where
primSizeInBytes _ = primSizeInBytes (Proxy :: Proxy a)
primBaUIndex ba (Offset a) = LE $ primBaUIndex ba (Offset a)
primMbaURead ba (Offset a) = LE <$> primMbaURead ba (Offset a)
primMbaUWrite mba (Offset a) (LE w) = primMbaUWrite mba (Offset a) w
primAddrIndex addr (Offset a) = LE $ primAddrIndex addr (Offset a)
primAddrRead addr (Offset a) = LE <$> primAddrRead addr (Offset a)
primAddrWrite addr (Offset a) (LE w) = primAddrWrite addr (Offset a) w
instance PrimType a => PrimType (BE a) where
primSizeInBytes _ = primSizeInBytes (Proxy :: Proxy a)
primBaUIndex ba (Offset a) = BE $ primBaUIndex ba (Offset a)
primMbaURead ba (Offset a) = BE <$> primMbaURead ba (Offset a)
primMbaUWrite mba (Offset a) (BE w) = primMbaUWrite mba (Offset a) w
primAddrIndex addr (Offset a) = BE $ primAddrIndex addr (Offset a)
primAddrRead addr (Offset a) = BE <$> primAddrRead addr (Offset a)
primAddrWrite addr (Offset a) (BE w) = primAddrWrite addr (Offset a) w
sizeRecast :: (PrimType a, PrimType b) => Size a -> Size b
sizeRecast = doRecast Proxy Proxy
where doRecast :: (PrimType a, PrimType b) => Proxy a -> Proxy b -> Size a -> Size b
doRecast pa pb sz =
let szA = primSizeInBytes pa
(Size szB) = primSizeInBytes pb
(Size bytes) = sizeOfE szA sz
in Size (bytes `Prelude.quot` szB)
primOffsetRecast :: (PrimType a, PrimType b) => Offset a -> Offset b
primOffsetRecast = doRecast Proxy Proxy
where doRecast :: (PrimType a, PrimType b) => Proxy a -> Proxy b -> Offset a -> Offset b
doRecast pa pb ofs =
let szA = primSizeInBytes pa
(Size szB) = primSizeInBytes pb
(Offset bytes) = offsetOfE szA ofs
in Offset (bytes `Prelude.quot` szB)
primOffsetOfE :: PrimType a => Offset a -> Offset8
primOffsetOfE = getOffset Proxy
where getOffset :: PrimType a => Proxy a -> Offset a -> Offset8
getOffset proxy = offsetOfE (primSizeInBytes proxy)
sizeAsOffset :: Size a -> Offset a
sizeAsOffset (Size a) = Offset a
offsetAsSize :: Offset a -> Size a
offsetAsSize (Offset a) = Size a
primWordGetByteAndShift :: Word# -> (# Word#, Word# #)
primWordGetByteAndShift w = (# and# w 0xff##, uncheckedShiftRL# w 8# #)
#if WORD_SIZE_IN_BITS == 64
primWord64GetByteAndShift :: Word# -> (# Word#, Word# #)
primWord64GetByteAndShift = primWord64GetByteAndShift
primWord64GetHiLo :: Word# -> (# Word#, Word# #)
primWord64GetHiLo w = (# uncheckedShiftRL# w 32# , and# w 0xffffffff## #)
#else
primWord64GetByteAndShift :: Word64# -> (# Word#, Word64# #)
primWord64GetByteAndShift w = (# and# (word64ToWord# w) 0xff##, uncheckedShiftRL64# w 8# #)
primWord64GetHiLo :: Word64# -> (# Word#, Word# #)
primWord64GetHiLo w = (# word64ToWord# (uncheckedShiftRL64# w 32#), word64ToWord# w #)
#endif