{-# LANGUAGE CPP #-}
module Bio.Util.Storable
( peekWord8
, peekUnalnWord16LE
, peekUnalnWord16BE
, peekUnalnWord32LE
, peekUnalnWord32BE
, pokeUnalnWord32LE
) where
#if __GLASGOW_HASKELL__ >= 710
#define HAVE_BYTESWAP_PRIMOPS
#endif
#if i386_HOST_ARCH || x86_64_HOST_ARCH
#define MEM_UNALIGNED_OPS
#endif
import BasePrelude
peekWord8 :: Ptr a -> IO Word8
peekWord8 :: Ptr a -> IO Word8
peekWord8 = Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8 -> IO Word8)
-> (Ptr a -> Ptr Word8) -> Ptr a -> IO Word8
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Ptr a -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr
#if defined(MEM_UNALIGNED_OPS) && defined(WORDS_BIGENDIAN) && defined(HAVE_BYTESWAP_PRIMOPS)
peekUnalnWord16LE :: Ptr a -> IO Word16
peekUnalnWord16LE = fmap byteSwap16 . peek . castPtr
peekUnalnWord32LE :: Ptr a -> IO Word32
peekUnalnWord32LE = fmap byteSwap32 . peek . castPtr
pokeUnalnWord32LE :: Ptr a -> Word32 -> IO ()
pokeUnalnWord32LE p w = poke (castPtr p) (byteSwap32 w)
#elif defined(MEM_UNALIGNED_OPS) && !defined(WORDS_BIGENDIAN)
peekUnalnWord16LE :: Ptr a -> IO Word16
peekUnalnWord16LE :: Ptr a -> IO Word16
peekUnalnWord16LE = Ptr Word16 -> IO Word16
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word16 -> IO Word16)
-> (Ptr a -> Ptr Word16) -> Ptr a -> IO Word16
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Ptr a -> Ptr Word16
forall a b. Ptr a -> Ptr b
castPtr
peekUnalnWord32LE :: Ptr a -> IO Word32
peekUnalnWord32LE :: Ptr a -> IO Word32
peekUnalnWord32LE = Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word32 -> IO Word32)
-> (Ptr a -> Ptr Word32) -> Ptr a -> IO Word32
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Ptr a -> Ptr Word32
forall a b. Ptr a -> Ptr b
castPtr
pokeUnalnWord32LE :: Ptr a -> Word32 -> IO ()
pokeUnalnWord32LE :: Ptr a -> Word32 -> IO ()
pokeUnalnWord32LE p :: Ptr a
p w :: Word32
w = Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr a -> Ptr Word32
forall a b. Ptr a -> Ptr b
castPtr Ptr a
p) Word32
w
#else
peekUnalnWord16LE :: Ptr a -> IO Word16
peekUnalnWord16LE p = do
x <- fromIntegral <$> peekWord8 (plusPtr p 0)
y <- fromIntegral <$> peekWord8 (plusPtr p 1)
return $! x .|. unsafeShiftL y 8
peekUnalnWord32LE :: Ptr a -> IO Word32
peekUnalnWord32LE p = do
x <- fromIntegral <$> peekWord8 (plusPtr p 0)
y <- fromIntegral <$> peekWord8 (plusPtr p 1)
z <- fromIntegral <$> peekWord8 (plusPtr p 2)
w <- fromIntegral <$> peekWord8 (plusPtr p 3)
return $! x .|. unsafeShiftL y 8 .|. unsafeShiftL z 16 .|. unsafeShiftL w 24
pokeUnalnWord32LE :: Ptr a -> Word32 -> IO ()
pokeUnalnWord32LE p w = do pokeByteOff p 0 (fromIntegral $ shiftR w 0 :: Word8)
pokeByteOff p 1 (fromIntegral $ shiftR w 8 :: Word8)
pokeByteOff p 2 (fromIntegral $ shiftR w 16 :: Word8)
pokeByteOff p 3 (fromIntegral $ shiftR w 24 :: Word8)
#endif
#if defined(MEM_UNALIGNED_OPS) && !defined(WORDS_BIGENDIAN) && defined(HAVE_BYTESWAP_PRIMOPS)
peekUnalnWord16BE :: Ptr a -> IO Word16
peekUnalnWord16BE :: Ptr a -> IO Word16
peekUnalnWord16BE = (Word16 -> Word16) -> IO Word16 -> IO Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word16 -> Word16
byteSwap16 (IO Word16 -> IO Word16)
-> (Ptr a -> IO Word16) -> Ptr a -> IO Word16
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Ptr Word16 -> IO Word16
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word16 -> IO Word16)
-> (Ptr a -> Ptr Word16) -> Ptr a -> IO Word16
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Ptr a -> Ptr Word16
forall a b. Ptr a -> Ptr b
castPtr
peekUnalnWord32BE :: Ptr a -> IO Word32
peekUnalnWord32BE :: Ptr a -> IO Word32
peekUnalnWord32BE = (Word32 -> Word32) -> IO Word32 -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> Word32
byteSwap32 (IO Word32 -> IO Word32)
-> (Ptr a -> IO Word32) -> Ptr a -> IO Word32
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word32 -> IO Word32)
-> (Ptr a -> Ptr Word32) -> Ptr a -> IO Word32
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Ptr a -> Ptr Word32
forall a b. Ptr a -> Ptr b
castPtr
#elif defined(MEM_UNALIGNED_OPS) && defined(WORDS_BIGENDIAN)
peekUnalnWord16BE :: Ptr a -> IO Word16
peekUnalnWord16BE = peek . castPtr
peekUnalnWord32BE :: Ptr a -> IO Word32
peekUnalnWord32BE = peek . castPtr
#else
peekUnalnWord16BE :: Ptr a -> IO Word16
peekUnalnWord16BE p = do
x <- fromIntegral <$> peekWord8 (plusPtr p 0)
y <- fromIntegral <$> peekWord8 (plusPtr p 1)
return $! y .|. unsafeShiftL x 8
peekUnalnWord32BE :: Ptr a -> IO Word32
peekUnalnWord32BE p = do
x <- fromIntegral <$> peekWord8 (plusPtr p 0)
y <- fromIntegral <$> peekWord8 (plusPtr p 1)
z <- fromIntegral <$> peekWord8 (plusPtr p 2)
w <- fromIntegral <$> peekWord8 (plusPtr p 3)
return $! w .|. unsafeShiftL z 8 .|. unsafeShiftL y 16 .|. unsafeShiftL x 24
#endif