1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
-- |
-- Module : Basement.Endianness
-- License : BSD-style
-- Maintainer : Haskell Foundation
-- Stability : experimental
-- Portability : portable
--
-- Set endianness tag to a given primitive. This will help for serialising
-- data for protocols (such as the network protocols).
--
{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Basement.Endianness
(
ByteSwap
-- * Big Endian
, BE(..), toBE, fromBE
-- * Little Endian
, LE(..), toLE, fromLE
-- * System Endianness
, Endianness(..)
, endianness
) where
import Basement.Compat.Base
import Data.Word (byteSwap16, byteSwap32, byteSwap64)
#if defined(ARCH_IS_LITTLE_ENDIAN) || defined(ARCH_IS_BIG_ENDIAN)
#else
import Foreign.Marshal.Alloc (alloca)
import Foreign.Ptr (castPtr)
import Foreign.Storable (poke, peek)
import Data.Word (Word8, Word32)
import System.IO.Unsafe (unsafePerformIO)
#endif
import Data.Bits
-- #if !defined(ARCH_IS_LITTLE_ENDIAN) && !defined(ARCH_IS_BIG_ENDIAN)
-- import Foundation.System.Info (endianness, Endianness(..))
-- #endif
data Endianness =
LittleEndian
| BigEndian
deriving (Eq, Show)
-- | Little Endian value
newtype LE a = LE { unLE :: a }
deriving (Show, Eq, Typeable, Bits)
instance (ByteSwap a, Ord a) => Ord (LE a) where
compare e1 e2 = compare (fromLE e1) (fromLE e2)
-- | Big Endian value
newtype BE a = BE { unBE :: a }
deriving (Show, Eq, Typeable, Bits)
instance (ByteSwap a, Ord a) => Ord (BE a) where
compare e1 e2 = compare (fromBE e1) (fromBE e2)
-- | Convert a value in cpu endianess to big endian
toBE :: ByteSwap a => a -> BE a
#ifdef ARCH_IS_LITTLE_ENDIAN
toBE = BE . byteSwap
#elif ARCH_IS_BIG_ENDIAN
toBE = BE
#else
toBE = BE . (if endianness == LittleEndian then byteSwap else id)
#endif
{-# INLINE toBE #-}
-- | Convert from a big endian value to the cpu endianness
fromBE :: ByteSwap a => BE a -> a
#ifdef ARCH_IS_LITTLE_ENDIAN
fromBE (BE a) = byteSwap a
#elif ARCH_IS_BIG_ENDIAN
fromBE (BE a) = a
#else
fromBE (BE a) = if endianness == LittleEndian then byteSwap a else a
#endif
{-# INLINE fromBE #-}
-- | Convert a value in cpu endianess to little endian
toLE :: ByteSwap a => a -> LE a
#ifdef ARCH_IS_LITTLE_ENDIAN
toLE = LE
#elif ARCH_IS_BIG_ENDIAN
toLE = LE . byteSwap
#else
toLE = LE . (if endianness == LittleEndian then id else byteSwap)
#endif
{-# INLINE toLE #-}
-- | Convert from a little endian value to the cpu endianness
fromLE :: ByteSwap a => LE a -> a
#ifdef ARCH_IS_LITTLE_ENDIAN
fromLE (LE a) = a
#elif ARCH_IS_BIG_ENDIAN
fromLE (LE a) = byteSwap a
#else
fromLE (LE a) = if endianness == LittleEndian then a else byteSwap a
#endif
{-# INLINE fromLE #-}
-- | endianness of the current architecture
endianness :: Endianness
#ifdef ARCH_IS_LITTLE_ENDIAN
endianness = LittleEndian
#elif ARCH_IS_BIG_ENDIAN
endianness = BigEndian
#else
-- ! ARCH_IS_UNKNOWN_ENDIAN
endianness = unsafePerformIO $ bytesToEndianness <$> word32ToByte input
where
input :: Word32
input = 0x01020304
{-# NOINLINE endianness #-}
word32ToByte :: Word32 -> IO Word8
word32ToByte word = alloca $ \wordPtr -> do
poke wordPtr word
peek (castPtr wordPtr)
bytesToEndianness :: Word8 -> Endianness
bytesToEndianness 1 = BigEndian
bytesToEndianness _ = LittleEndian
#endif
-- | Class of types that can be byte-swapped.
--
-- e.g. Word16, Word32, Word64
class ByteSwap a where
byteSwap :: a -> a
instance ByteSwap Word16 where
byteSwap = byteSwap16
instance ByteSwap Word32 where
byteSwap = byteSwap32
instance ByteSwap Word64 where
byteSwap = byteSwap64
|
