module Cgm.System.Endian (
Endian(..),
swapHalves,
ixBytes,
littleEndianIxBytes,
bigEndianIxBytes,
platformEndianness,
platformWordEndianness,
ByteSwapped,
swapBytes,
unswapBytes,
Endianness(..),
reverseEndianness
) where
import Data.Bits
import Data.Ix
import Control.Applicative
import Foreign.Marshal.Alloc
import Foreign.Ptr
import Foreign.Storable
import Cgm.Data.Tagged
import Cgm.Data.Word
import Cgm.Data.Array
import Cgm.Data.Len
import Cgm.Data.Structured
import Cgm.Control.InFunctor
import Cgm.Control.Combinators
class (Prim w, Bits w, Num w) => Endian w where
untypedSwapBytes :: w -> w
instance Endian Word8 where
untypedSwapBytes = id
instance Endian Word16 where
untypedSwapBytes = swapHalves
instance Endian Word32 where
untypedSwapBytes = swapMask 0xff00ff 8 . swapHalves
instance Endian Word64 where
untypedSwapBytes = swapMask 0xff00ff00ff00ff 8 . swapMask 0xffff0000ffff 16 . swapHalves
instance Endian Word where
untypedSwapBytes = onWordConvB (flip liftItI untypedSwapBytes) (flip liftItI untypedSwapBytes)
swapHalves :: forall w. Bits w => w -> w
swapHalves w = w `shiftR` halfBitSize .|. w `shiftL` halfBitSize where
halfBitSize = bitSize (undefined :: w) `div` 2
swapMask :: Bits w => w -> Int -> w -> w
swapMask mask shift w = ((w `shiftR` shift) .&. mask) .|. ((w .&. mask) `shiftL` shift)
byteNumbers :: forall w. Endian w => w
byteNumbers = foldr (.|.) 0 $ fmap (\n -> fromIntegral n `shiftL` (8 * fromIntegral n)) $ (at :: At w) increasingBytes
increasingBytes :: forall w. Prim w => Tagged w [Word8]
increasingBytes = Tagged $ range (0, fromIntegral (primSizeOf (undefined :: w)) 1)
singletonArray :: Prim w => w -> PrimArray Free w
singletonArray w = runSTPrimArray (mkArray 1 >>= \a -> a <$ writeArray a 0 w)
ixBytes :: forall w. Endian w => w -> [Word8]
ixBytes w = let a = unsafePrimArrayCast (singletonArray w) :: PrimArray Free Word8 in indexArray a . unsafeLen . fromIntegral <$> (at :: At w) increasingBytes
littleEndianIxBytes :: forall w. Prim w => Tagged w [Word8]
littleEndianIxBytes = increasingBytes
bigEndianIxBytes :: forall w. Prim w => Tagged w [Word8]
bigEndianIxBytes = reverse <$> increasingBytes
data Endianness = LittleEndian | BigEndian deriving (Eq, Show)
platformEndianness :: forall w. Endian w => Tagged w Endianness
platformEndianness = do
let plat = ixBytes (byteNumbers :: w)
l <- littleEndianIxBytes
b <- bigEndianIxBytes
if plat == l then return LittleEndian else if plat == b then return BigEndian else undefined
platformWordEndianness :: Endianness
platformWordEndianness = (at :: At Word) platformEndianness
reverseEndianness LittleEndian = BigEndian
reverseEndianness BigEndian = LittleEndian
newtype ByteSwapped w = ByteSwapped w deriving (Prim, Show)
swapBytes :: Endian w => w -> ByteSwapped w
swapBytes = ByteSwapped . untypedSwapBytes
unswapBytes :: Endian w => ByteSwapped w -> w
unswapBytes (ByteSwapped w) = untypedSwapBytes w
deriveStructured ''Endianness