{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP, NoImplicitPrelude, ScopedTypeVariables, BangPatterns #-}
module Foreign.Storable
( Storable(
sizeOf,
alignment,
peekElemOff,
pokeElemOff,
peekByteOff,
pokeByteOff,
peek,
poke)
) where
#include "MachDeps.h"
#include "HsBaseConfig.h"
import GHC.Storable
import GHC.Stable ( StablePtr )
import GHC.Num
import GHC.Int
import GHC.Word
import GHC.Ptr
import GHC.Base
import GHC.Fingerprint.Type
import Data.Bits
import GHC.Real
class Storable a where
{-# MINIMAL sizeOf, alignment,
(peek | peekElemOff | peekByteOff),
(poke | pokeElemOff | pokeByteOff) #-}
sizeOf :: a -> Int
alignment :: a -> Int
peekElemOff :: Ptr a -> Int -> IO a
pokeElemOff :: Ptr a -> Int -> a -> IO ()
peekByteOff :: Ptr b -> Int -> IO a
pokeByteOff :: Ptr b -> Int -> a -> IO ()
peek :: Ptr a -> IO a
poke :: Ptr a -> a -> IO ()
peekElemOff = a -> Ptr a -> Int -> IO a
peekElemOff_ a
forall a. HasCallStack => a
undefined
where peekElemOff_ :: a -> Ptr a -> Int -> IO a
peekElemOff_ :: a -> Ptr a -> Int -> IO a
peekElemOff_ a
undef Ptr a
ptr Int
off = Ptr a -> Int -> IO a
forall b. Ptr b -> Int -> IO a
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr a
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Storable a => a -> Int
sizeOf a
undef)
pokeElemOff Ptr a
ptr Int
off a
val = Ptr a -> Int -> a -> IO ()
forall b. Ptr b -> Int -> a -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr a
ptr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Storable a => a -> Int
sizeOf a
val) a
val
peekByteOff Ptr b
ptr Int
off = Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek (Ptr b
ptr Ptr b -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off)
pokeByteOff Ptr b
ptr Int
off = Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr b
ptr Ptr b -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off)
peek Ptr a
ptr = Ptr a -> Int -> IO a
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr a
ptr Int
0
poke Ptr a
ptr = Ptr a -> Int -> a -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr a
ptr Int
0
instance Storable () where
sizeOf :: () -> Int
sizeOf ()
_ = Int
0
alignment :: () -> Int
alignment ()
_ = Int
1
peek :: Ptr () -> IO ()
peek Ptr ()
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
poke :: Ptr () -> () -> IO ()
poke Ptr ()
_ ()
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
instance Storable Bool where
sizeOf :: Bool -> Int
sizeOf Bool
_ = Int32 -> Int
forall a. Storable a => a -> Int
sizeOf (Int32
forall a. HasCallStack => a
undefined::HTYPE_INT)
alignment :: Bool -> Int
alignment Bool
_ = Int32 -> Int
forall a. Storable a => a -> Int
alignment (Int32
forall a. HasCallStack => a
undefined::HTYPE_INT)
peekElemOff :: Ptr Bool -> Int -> IO Bool
peekElemOff Ptr Bool
p Int
i = (Int32 -> Bool) -> IO Int32 -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
/= (Int32
0::HTYPE_INT)) $ peekElemOff (castPtr p) i
pokeElemOff :: Ptr Bool -> Int -> Bool -> IO ()
pokeElemOff Ptr Bool
p Int
i Bool
x = Ptr Int32 -> Int -> Int32 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff (Ptr Bool -> Ptr Int32
forall a b. Ptr a -> Ptr b
castPtr Ptr Bool
p) Int
i (if Bool
x then Int32
1 else Int32
0::HTYPE_INT)
#define STORABLE(T,size,align,read,write) \
instance Storable (T) where { \
sizeOf _ = size; \
alignment _ = align; \
peekElemOff = read; \
pokeElemOff = write }
STORABLE(Char,SIZEOF_INT32,ALIGNMENT_INT32,
readWideCharOffPtr,writeWideCharOffPtr)
STORABLE(Int,SIZEOF_HSINT,ALIGNMENT_HSINT,
readIntOffPtr,writeIntOffPtr)
STORABLE(Word,SIZEOF_HSWORD,ALIGNMENT_HSWORD,
readWordOffPtr,writeWordOffPtr)
STORABLE((Ptr a),SIZEOF_HSPTR,ALIGNMENT_HSPTR,
readPtrOffPtr,writePtrOffPtr)
STORABLE((FunPtr a),SIZEOF_HSFUNPTR,ALIGNMENT_HSFUNPTR,
readFunPtrOffPtr,writeFunPtrOffPtr)
STORABLE((StablePtr a),SIZEOF_HSSTABLEPTR,ALIGNMENT_HSSTABLEPTR,
readStablePtrOffPtr,writeStablePtrOffPtr)
STORABLE(Float,SIZEOF_HSFLOAT,ALIGNMENT_HSFLOAT,
readFloatOffPtr,writeFloatOffPtr)
STORABLE(Double,SIZEOF_HSDOUBLE,ALIGNMENT_HSDOUBLE,
readDoubleOffPtr,writeDoubleOffPtr)
STORABLE(Word8,SIZEOF_WORD8,ALIGNMENT_WORD8,
readWord8OffPtr,writeWord8OffPtr)
STORABLE(Word16,SIZEOF_WORD16,ALIGNMENT_WORD16,
readWord16OffPtr,writeWord16OffPtr)
STORABLE(Word32,SIZEOF_WORD32,ALIGNMENT_WORD32,
readWord32OffPtr,writeWord32OffPtr)
STORABLE(Word64,SIZEOF_WORD64,ALIGNMENT_WORD64,
readWord64OffPtr,writeWord64OffPtr)
STORABLE(Int8,SIZEOF_INT8,ALIGNMENT_INT8,
readInt8OffPtr,writeInt8OffPtr)
STORABLE(Int16,SIZEOF_INT16,ALIGNMENT_INT16,
readInt16OffPtr,writeInt16OffPtr)
STORABLE(Int32,SIZEOF_INT32,ALIGNMENT_INT32,
readInt32OffPtr,writeInt32OffPtr)
STORABLE(Int64,SIZEOF_INT64,ALIGNMENT_INT64,
readInt64OffPtr,writeInt64OffPtr)
instance (Storable a, Integral a) => Storable (Ratio a) where
sizeOf :: Ratio a -> Int
sizeOf Ratio a
_ = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a)
alignment :: Ratio a -> Int
alignment Ratio a
_ = a -> Int
forall a. Storable a => a -> Int
alignment (a
forall a. HasCallStack => a
undefined :: a )
peek :: Ptr (Ratio a) -> IO (Ratio a)
peek Ptr (Ratio a)
p = do
Ptr a
q <- Ptr a -> IO (Ptr a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr a -> IO (Ptr a)) -> Ptr a -> IO (Ptr a)
forall a b. (a -> b) -> a -> b
$ Ptr (Ratio a) -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr (Ratio a)
p
a
r <- Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
q
a
i <- Ptr a -> Int -> IO a
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr a
q Int
1
Ratio a -> IO (Ratio a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
r a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
% a
i)
poke :: Ptr (Ratio a) -> Ratio a -> IO ()
poke Ptr (Ratio a)
p (a
r :% a
i) = do
Ptr a
q <-Ptr a -> IO (Ptr a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr a -> IO (Ptr a)) -> Ptr a -> IO (Ptr a)
forall a b. (a -> b) -> a -> b
$ (Ptr (Ratio a) -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr (Ratio a)
p)
Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
q a
r
Ptr a -> Int -> a -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr a
q Int
1 a
i
instance Storable Fingerprint where
sizeOf :: Fingerprint -> Int
sizeOf Fingerprint
_ = Int
16
alignment :: Fingerprint -> Int
alignment Fingerprint
_ = Int
8
peek :: Ptr Fingerprint -> IO Fingerprint
peek = Ptr Fingerprint -> IO Fingerprint
peekFingerprint
poke :: Ptr Fingerprint -> Fingerprint -> IO ()
poke = Ptr Fingerprint -> Fingerprint -> IO ()
pokeFingerprint
peekFingerprint :: Ptr Fingerprint -> IO Fingerprint
peekFingerprint :: Ptr Fingerprint -> IO Fingerprint
peekFingerprint Ptr Fingerprint
p0 = do
let peekW64 :: Ptr Word8 -> Int -> Word64 -> IO Word64
peekW64 :: Ptr Word8 -> Int -> Word64 -> IO Word64
peekW64 Ptr Word8
_ Int
0 !Word64
i = Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
i
peekW64 !Ptr Word8
p !Int
n !Word64
i = do
Word8
w8 <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
p
Ptr Word8 -> Int -> Word64 -> IO Word64
peekW64 (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
((Word64
i Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w8)
Word64
high <- Ptr Word8 -> Int -> Word64 -> IO Word64
peekW64 (Ptr Fingerprint -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Fingerprint
p0) Int
8 Word64
0
Word64
low <- Ptr Word8 -> Int -> Word64 -> IO Word64
peekW64 (Ptr Fingerprint -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr Fingerprint
p0 Ptr Any -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) Int
8 Word64
0
Fingerprint -> IO Fingerprint
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Word64 -> Fingerprint
Fingerprint Word64
high Word64
low)
pokeFingerprint :: Ptr Fingerprint -> Fingerprint -> IO ()
pokeFingerprint :: Ptr Fingerprint -> Fingerprint -> IO ()
pokeFingerprint Ptr Fingerprint
p0 (Fingerprint Word64
high Word64
low) = do
let pokeW64 :: Ptr Word8 -> Int -> Word64 -> IO ()
pokeW64 :: Ptr Word8 -> Int -> Word64 -> IO ()
pokeW64 Ptr Word8
_ Int
0 Word64
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
pokeW64 Ptr Word8
p !Int
n !Word64
i = do
Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
p (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i)
Ptr Word8 -> Int -> Word64 -> IO ()
pokeW64 Ptr Word8
p (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Word64
i Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
8)
Ptr Word8 -> Int -> Word64 -> IO ()
pokeW64 (Ptr Fingerprint -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Fingerprint
p0) Int
8 Word64
high
Ptr Word8 -> Int -> Word64 -> IO ()
pokeW64 (Ptr Fingerprint -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr Fingerprint
p0 Ptr Any -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) Int
8 Word64
low