<commit_before>{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Byte order ("endianness")
--
-- Indicate in which order bytes are stored in memory for multi-bytes types.
-- Big-endian means that most-significant bytes come first. Little-endian means
-- that least-significant bytes come first.
module ViperVM.Format.Binary.Endianness
   ( Endianness(..)
   , WordGetters (..)
   , WordPutters (..)
   , getWordGetters
   , getWordPutters
   , WordSize (..)
   , ExtendedWordGetters (..)
   , ExtendedWordPutters (..)
   , getExtendedWordGetters
   , getExtendedWordPutters
   , getHostEndianness
   , hostEndianness
   , ByteReversable (..)
   , AsBigEndian (..)
   , AsLittleEndian (..)
   )
where

import ViperVM.Format.Binary.Get
import ViperVM.Format.Binary.Put
import ViperVM.Format.Binary.Enum
import ViperVM.Format.Binary.Ptr
import ViperVM.Format.Binary.Bits ((.|.), shiftL)
import ViperVM.Format.Binary.Storable

import GHC.Word
import Foreign.Storable
import Foreign.CStorable
import System.IO.Unsafe
import Foreign.Marshal.Array
import Foreign.Marshal.Alloc (alloca)

-- | Endianness
data Endianness 
   = LittleEndian    -- ^ Less significant bytes first
   | BigEndian       -- ^ Most significant bytes first
   deriving (Eq,Show,Enum)

instance CEnum Endianness

-- | Word getter
data WordGetters = WordGetters
   { wordGetter8  :: Get Word8   -- ^ Read a Word8
   , wordGetter16 :: Get Word16  -- ^ Read a Word16
   , wordGetter32 :: Get Word32  -- ^ Read a Word132
   , wordGetter64 :: Get Word64  -- ^ Read a Word64
   }

-- | Word putters
data WordPutters = WordPutters
   { wordPutter8  :: Word8  -> Put -- ^ Write a Word8
   , wordPutter16 :: Word16 -> Put -- ^ Write a Word16
   , wordPutter32 :: Word32 -> Put -- ^ Write a Word132
   , wordPutter64 :: Word64 -> Put -- ^ Write a Word64
   }

-- | Get getters for the given endianness
getWordGetters :: Endianness -> WordGetters
getWordGetters e = case e of
   LittleEndian -> WordGetters getWord8 getWord16le getWord32le getWord64le
   BigEndian    -> WordGetters getWord8 getWord16be getWord32be getWord64be

-- | Get putters for the given endianness
getWordPutters :: Endianness -> WordPutters
getWordPutters e = case e of
   LittleEndian -> WordPutters putWord8 putWord16le putWord32le putWord64le
   BigEndian    -> WordPutters putWord8 putWord16be putWord32be putWord64be



-- | Size of a machine word
data WordSize
   = WordSize32      -- ^ 32-bit
   | WordSize64      -- ^ 64-bit
   deriving (Show, Eq)

-- | Extended word getters
data ExtendedWordGetters = ExtendedWordGetters
   { extwordGetter8  :: Get Word8   -- ^ Read a Word8
   , extwordGetter16 :: Get Word16  -- ^ Read a Word16
   , extwordGetter32 :: Get Word32  -- ^ Read a Word132
   , extwordGetter64 :: Get Word64  -- ^ Read a Word64
   , extwordGetterN  :: Get Word64  -- ^ Read a native size word into a Word64
   }

-- | Extended word putters
data ExtendedWordPutters = ExtendedWordPutters
   { extwordPutter8  :: Word8  -> Put -- ^ Write a Word8
   , extwordPutter16 :: Word16 -> Put -- ^ Write a Word16
   , extwordPutter32 :: Word32 -> Put -- ^ Write a Word132
   , extwordPutter64 :: Word64 -> Put -- ^ Write a Word64
   , extwordPutterN  :: Word64 -> Put -- ^ Write a Word64 into a native size word
   }

-- | Return extended getters
getExtendedWordGetters :: Endianness -> WordSize -> ExtendedWordGetters
getExtendedWordGetters endian ws = ExtendedWordGetters gw8 gw16 gw32 gw64 gwN
   where
      WordGetters gw8 gw16 gw32 gw64 = getWordGetters endian
      gwN = case ws of
         WordSize64 -> gw64
         WordSize32 -> fromIntegral <$> gw32

-- | Return extended putters
getExtendedWordPutters :: Endianness -> WordSize -> ExtendedWordPutters
getExtendedWordPutters endian ws = ExtendedWordPutters pw8 pw16 pw32 pw64 pwN
   where
      WordPutters pw8 pw16 pw32 pw64 = getWordPutters endian
      pwN x = case ws of
         WordSize64 -> pw64 x
         WordSize32 -> if x > 0xffffffff
            then error $ "Number too big to be stored in 32-bit word ("++show x++")"
            else pw32 (fromIntegral x)

-- | Detect the endianness of the host memory
getHostEndianness :: IO Endianness
getHostEndianness = do
   -- Write a 32 bit Int and check byte ordering
   let magic = 1 .|. shiftL 8 2 .|. shiftL 16 3 .|. shiftL 24 4 :: Word32
   alloca $ \p -> do
      poke p magic
      rs <- peekArray 4 (castPtr p :: Ptr Word8)
      return $ if rs == [1,2,3,4] then BigEndian else LittleEndian

-- | Detected host endianness
hostEndianness :: Endianness
hostEndianness = unsafePerformIO getHostEndianness

{-# NOINLINE hostEndianness #-}


-- | Reverse bytes in a word
class ByteReversable w where
   reverseBytes       :: w -> w

   hostToBigEndian    :: w -> w
   hostToBigEndian w = case hostEndianness of
      BigEndian    -> w
      LittleEndian -> reverseBytes w

   bigEndianToHost    :: w -> w
   bigEndianToHost w = case hostEndianness of
      BigEndian    -> w
      LittleEndian -> reverseBytes w


   hostToLittleEndian :: w -> w
   hostToLittleEndian w = case hostEndianness of
      BigEndian    -> reverseBytes w
      LittleEndian -> w

   littleEndianToHost :: w -> w
   littleEndianToHost w = case hostEndianness of
      BigEndian    -> reverseBytes w
      LittleEndian -> w

instance ByteReversable Word8 where
   reverseBytes = id

instance ByteReversable Word16 where
   reverseBytes = byteSwap16
                  
instance ByteReversable Word32 where
   reverseBytes = byteSwap32

instance ByteReversable Word64 where
   reverseBytes = byteSwap64



newtype AsBigEndian a    = AsBigEndian a    deriving (Show,Eq,Ord,Enum,Num,Integral,Real)
newtype AsLittleEndian a = AsLittleEndian a deriving (Show,Eq,Ord,Enum,Num,Integral,Real)

instance (ByteReversable a, StaticStorable a) => StaticStorable (AsBigEndian a) where
   type SizeOf (AsBigEndian a)    = SizeOf a
   type Alignment (AsBigEndian a) = Alignment a
<commit_msg>Fix Show instances for AsBigEndian and AsLittleEndian<commit_after>{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Byte order ("endianness")
--
-- Indicate in which order bytes are stored in memory for multi-bytes types.
-- Big-endian means that most-significant bytes come first. Little-endian means
-- that least-significant bytes come first.
module ViperVM.Format.Binary.Endianness
   ( Endianness(..)
   , WordGetters (..)
   , WordPutters (..)
   , getWordGetters
   , getWordPutters
   , WordSize (..)
   , ExtendedWordGetters (..)
   , ExtendedWordPutters (..)
   , getExtendedWordGetters
   , getExtendedWordPutters
   , getHostEndianness
   , hostEndianness
   , ByteReversable (..)
   , AsBigEndian (..)
   , AsLittleEndian (..)
   )
where

import ViperVM.Format.Binary.Get
import ViperVM.Format.Binary.Put
import ViperVM.Format.Binary.Enum
import ViperVM.Format.Binary.Ptr
import ViperVM.Format.Binary.Bits ((.|.), shiftL)
import ViperVM.Format.Binary.Storable

import GHC.Word
import Foreign.Storable
import Foreign.CStorable
import System.IO.Unsafe
import Foreign.Marshal.Array
import Foreign.Marshal.Alloc (alloca)

-- | Endianness
data Endianness 
   = LittleEndian    -- ^ Less significant bytes first
   | BigEndian       -- ^ Most significant bytes first
   deriving (Eq,Show,Enum)

instance CEnum Endianness

-- | Word getter
data WordGetters = WordGetters
   { wordGetter8  :: Get Word8   -- ^ Read a Word8
   , wordGetter16 :: Get Word16  -- ^ Read a Word16
   , wordGetter32 :: Get Word32  -- ^ Read a Word132
   , wordGetter64 :: Get Word64  -- ^ Read a Word64
   }

-- | Word putters
data WordPutters = WordPutters
   { wordPutter8  :: Word8  -> Put -- ^ Write a Word8
   , wordPutter16 :: Word16 -> Put -- ^ Write a Word16
   , wordPutter32 :: Word32 -> Put -- ^ Write a Word132
   , wordPutter64 :: Word64 -> Put -- ^ Write a Word64
   }

-- | Get getters for the given endianness
getWordGetters :: Endianness -> WordGetters
getWordGetters e = case e of
   LittleEndian -> WordGetters getWord8 getWord16le getWord32le getWord64le
   BigEndian    -> WordGetters getWord8 getWord16be getWord32be getWord64be

-- | Get putters for the given endianness
getWordPutters :: Endianness -> WordPutters
getWordPutters e = case e of
   LittleEndian -> WordPutters putWord8 putWord16le putWord32le putWord64le
   BigEndian    -> WordPutters putWord8 putWord16be putWord32be putWord64be



-- | Size of a machine word
data WordSize
   = WordSize32      -- ^ 32-bit
   | WordSize64      -- ^ 64-bit
   deriving (Show, Eq)

-- | Extended word getters
data ExtendedWordGetters = ExtendedWordGetters
   { extwordGetter8  :: Get Word8   -- ^ Read a Word8
   , extwordGetter16 :: Get Word16  -- ^ Read a Word16
   , extwordGetter32 :: Get Word32  -- ^ Read a Word132
   , extwordGetter64 :: Get Word64  -- ^ Read a Word64
   , extwordGetterN  :: Get Word64  -- ^ Read a native size word into a Word64
   }

-- | Extended word putters
data ExtendedWordPutters = ExtendedWordPutters
   { extwordPutter8  :: Word8  -> Put -- ^ Write a Word8
   , extwordPutter16 :: Word16 -> Put -- ^ Write a Word16
   , extwordPutter32 :: Word32 -> Put -- ^ Write a Word132
   , extwordPutter64 :: Word64 -> Put -- ^ Write a Word64
   , extwordPutterN  :: Word64 -> Put -- ^ Write a Word64 into a native size word
   }

-- | Return extended getters
getExtendedWordGetters :: Endianness -> WordSize -> ExtendedWordGetters
getExtendedWordGetters endian ws = ExtendedWordGetters gw8 gw16 gw32 gw64 gwN
   where
      WordGetters gw8 gw16 gw32 gw64 = getWordGetters endian
      gwN = case ws of
         WordSize64 -> gw64
         WordSize32 -> fromIntegral <$> gw32

-- | Return extended putters
getExtendedWordPutters :: Endianness -> WordSize -> ExtendedWordPutters
getExtendedWordPutters endian ws = ExtendedWordPutters pw8 pw16 pw32 pw64 pwN
   where
      WordPutters pw8 pw16 pw32 pw64 = getWordPutters endian
      pwN x = case ws of
         WordSize64 -> pw64 x
         WordSize32 -> if x > 0xffffffff
            then error $ "Number too big to be stored in 32-bit word ("++show x++")"
            else pw32 (fromIntegral x)

-- | Detect the endianness of the host memory
getHostEndianness :: IO Endianness
getHostEndianness = do
   -- Write a 32 bit Int and check byte ordering
   let magic = 1 .|. shiftL 8 2 .|. shiftL 16 3 .|. shiftL 24 4 :: Word32
   alloca $ \p -> do
      poke p magic
      rs <- peekArray 4 (castPtr p :: Ptr Word8)
      return $ if rs == [1,2,3,4] then BigEndian else LittleEndian

-- | Detected host endianness
hostEndianness :: Endianness
hostEndianness = unsafePerformIO getHostEndianness

{-# NOINLINE hostEndianness #-}


-- | Reverse bytes in a word
class ByteReversable w where
   reverseBytes       :: w -> w

   hostToBigEndian    :: w -> w
   hostToBigEndian w = case hostEndianness of
      BigEndian    -> w
      LittleEndian -> reverseBytes w

   bigEndianToHost    :: w -> w
   bigEndianToHost w = case hostEndianness of
      BigEndian    -> w
      LittleEndian -> reverseBytes w


   hostToLittleEndian :: w -> w
   hostToLittleEndian w = case hostEndianness of
      BigEndian    -> reverseBytes w
      LittleEndian -> w

   littleEndianToHost :: w -> w
   littleEndianToHost w = case hostEndianness of
      BigEndian    -> reverseBytes w
      LittleEndian -> w

instance ByteReversable Word8 where
   reverseBytes = id

instance ByteReversable Word16 where
   reverseBytes = byteSwap16
                  
instance ByteReversable Word32 where
   reverseBytes = byteSwap32

instance ByteReversable Word64 where
   reverseBytes = byteSwap64



newtype AsBigEndian a    = AsBigEndian a    deriving (Eq,Ord,Enum,Num,Integral,Real)

instance Show a => Show (AsBigEndian a) where
   show (AsBigEndian a) = show a

newtype AsLittleEndian a = AsLittleEndian a deriving (Eq,Ord,Enum,Num,Integral,Real)

instance Show a => Show (AsLittleEndian a) where
   show (AsLittleEndian a) = show a

instance (ByteReversable a, StaticStorable a) => StaticStorable (AsBigEndian a) where
   type SizeOf (AsBigEndian a)    = SizeOf a
   type Alignment (AsBigEndian a) = Alignment a

{'fraction_non_alphanumeric': 0.08572603866721513, 'fraction_numerical': 0.03471822295351707, 'mean_word_length': 2.9960552268244576, 'pattern_counts': {'":': 0, '<': 7, '<?xml version=': 0, '>': 85, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 2, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1680171', 'n_tokens_mistral': 4223, 'n_tokens_neox': 3919, 'n_words': 1186}