module Foundation.Primitive.Types
( PrimType(..)
, PrimMemoryComparable
, primBaIndex
, primMbaRead
, primMbaWrite
, primArrayIndex
, primMutableArrayRead
, primMutableArrayWrite
, primOffsetOfE
, primOffsetRecast
, sizeRecast
, offsetAsSize
, sizeAsOffset
, sizeInBytes
, offsetInBytes
, 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 (CountOf 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 :: CountOf Word8
#if WORD_SIZE_IN_BITS == 64
sizeInt = CountOf 8
sizeWord = CountOf 8
#else
sizeInt = CountOf 4
sizeWord = CountOf 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 _ = CountOf 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 _ = CountOf 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 _ = CountOf 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 _ = CountOf 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 _ = CountOf 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 _ = CountOf 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 _ = CountOf 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 _ = CountOf 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 _ = CountOf 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 _ = CountOf 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 _ = CountOf 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 _ = CountOf 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 _ = CountOf 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
class PrimMemoryComparable ty where
instance PrimMemoryComparable Int where
instance PrimMemoryComparable Word where
instance PrimMemoryComparable Word8 where
instance PrimMemoryComparable Word16 where
instance PrimMemoryComparable Word32 where
instance PrimMemoryComparable Word64 where
instance PrimMemoryComparable Int8 where
instance PrimMemoryComparable Int16 where
instance PrimMemoryComparable Int32 where
instance PrimMemoryComparable Int64 where
instance PrimMemoryComparable Char where
instance PrimMemoryComparable CChar where
instance PrimMemoryComparable CUChar where
instance PrimMemoryComparable a => PrimMemoryComparable (LE a) where
instance PrimMemoryComparable a => PrimMemoryComparable (BE a) where
sizeRecast :: forall a b . (PrimType a, PrimType b) => CountOf a -> CountOf b
sizeRecast sz = CountOf (bytes `Prelude.quot` szB)
where !szA = primSizeInBytes (Proxy :: Proxy a)
!(CountOf szB) = primSizeInBytes (Proxy :: Proxy b)
!(CountOf bytes) = sizeOfE szA sz
sizeRecastBytes :: forall b . PrimType b => CountOf Word8 -> CountOf b
sizeRecastBytes (CountOf w) = CountOf (w `Prelude.quot` szB)
where !(CountOf szB) = primSizeInBytes (Proxy :: Proxy b)
sizeInBytes :: forall a . PrimType a => CountOf a -> CountOf Word8
sizeInBytes sz = sizeOfE (primSizeInBytes (Proxy :: Proxy a)) sz
offsetInBytes :: forall a . PrimType a => Offset a -> Offset Word8
offsetInBytes sz = offsetOfE (primSizeInBytes (Proxy :: Proxy a)) sz
primOffsetRecast :: forall a b . (PrimType a, PrimType b) => Offset a -> Offset b
primOffsetRecast !ofs =
let !(Offset bytes) = offsetOfE szA ofs
in Offset (bytes `Prelude.quot` szB)
where
!szA = primSizeInBytes (Proxy :: Proxy a)
!(CountOf szB) = primSizeInBytes (Proxy :: Proxy b)
primOffsetRecastBytes :: forall b . PrimType b => Offset Word8 -> Offset b
primOffsetRecastBytes !(Offset o) = Offset (szA `Prelude.quot` o)
where !(CountOf szA) = primSizeInBytes (Proxy :: Proxy b)
primOffsetOfE :: forall a . PrimType a => Offset a -> Offset Word8
primOffsetOfE = offsetInBytes
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