ghc/lib/glaExts/Word.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1996
   3 %
   4
   5 \section[Word]{Module @Word@}
   6
   7 This code is largely copied from the Hugs library of the same name.
   8
   9 \begin{code}
  10 {-# OPTIONS -fno-implicit-prelude #-}
  11
  12 module Word
  13         ( Word8
  14         , Word16
  15         , Word32
  16         , Word64
  17         , word8ToWord32  -- :: Word8  -> Word32
  18         , word32ToWord8  -- :: Word32 -> Word8
  19         , word16ToWord32 -- :: Word16 -> Word32
  20         , word32ToWord16 -- :: Word32 -> Word16
  21         , word8ToInt     -- :: Word8  -> Int
  22         , intToWord8     -- :: Int    -> Word8
  23         , word16ToInt    -- :: Word16 -> Int
  24         , intToWord16    -- :: Int    -> Word16
  25         , word32ToInt    -- :: Word32 -> Int
  26         , intToWord32    -- :: Int    -> Word32
  27         ) where
  28
  29 import PrelBase
  30 import PrelNum
  31 import PrelRead
  32 import Ix
  33 import Error
  34 import Bits
  35 import GHC
  36
  37 -----------------------------------------------------------------------------
  38 -- The "official" coercion functions
  39 -----------------------------------------------------------------------------
  40
  41 word8ToWord32  :: Word8  -> Word32
  42 word32ToWord8  :: Word32 -> Word8
  43 word16ToWord32 :: Word16 -> Word32
  44 word32ToWord16 :: Word32 -> Word16
  45
  46 word8ToInt   :: Word8  -> Int
  47 intToWord8   :: Int    -> Word8
  48 word16ToInt  :: Word16 -> Int
  49 intToWord16  :: Int    -> Word16
  50
  51 word8ToInt  = word32ToInt    . word8ToWord32
  52 intToWord8  = word32ToWord8  . intToWord32
  53 word16ToInt = word32ToInt    . word16ToWord32
  54 intToWord16 = word32ToWord16 . intToWord32
  55
  56 intToWord32 (I# x)   = W32# (int2Word# x)
  57 word32ToInt (W32# x) = I#   (word2Int# x)
  58
  59 -----------------------------------------------------------------------------
  60 -- Word8
  61 -----------------------------------------------------------------------------
  62
  63 newtype Word8  = W8 Word32
  64
  65 word8ToWord32 (W8 x) = x .&. 0xff
  66 word32ToWord8 = W8
  67
  68 instance Eq  Word8     where (==)    = binop (==)
  69 instance Ord Word8     where compare = binop compare
  70
  71 instance Num Word8 where
  72     x + y         = to (binop (+) x y)
  73     x - y         = to (binop (-) x y)
  74     negate        = to . negate . from
  75     x * y         = to (binop (*) x y)
  76     abs x         = x
  77     signum        = signumReal
  78     fromInteger   = to . integer2Word
  79     fromInt       = intToWord8
  80
  81 instance Bounded Word8 where
  82     minBound = 0
  83     maxBound = 0xff
  84
  85 instance Real Word8 where
  86     toRational x = toInteger x % 1
  87
  88 instance Integral Word8 where
  89     x `div` y     = to  (binop div x y)
  90     x `quot` y    = to  (binop quot x y)
  91     x `rem` y     = to  (binop rem x y)
  92     x `mod` y     = to  (binop mod x y)
  93     x `quotRem` y = to2 (binop quotRem x y)
  94     divMod        = quotRem
  95     toInteger     = toInteger . from
  96     toInt         = word8ToInt
  97
  98 instance Ix Word8 where
  99     range (m,n)          = [m..n]
 100     index b@(m,n) i
 101            | inRange b i = word32ToInt (from (i - m))
 102            | otherwise   = error "index: Index out of range"
 103     inRange (m,n) i      = m <= i && i <= n
 104
 105 instance Enum Word8 where
 106     toEnum         = to . intToWord32
 107     fromEnum       = word32ToInt . from
 108     enumFrom c       = map toEnum [fromEnum c .. fromEnum (maxBound::Word8)]
 109     enumFromThen c d = map toEnum [fromEnum c, fromEnum d .. fromEnum (last::Word8)]
 110                        where last = if d < c then minBound else maxBound
 111
 112 instance Read Word8 where
 113     readsPrec p = readDec
 114
 115 instance Show Word8 where
 116     showsPrec p = showInt
 117
 118 instance Bits Word8 where
 119   x .&. y       = to (binop (.&.) x y)
 120   x .|. y       = to (binop (.|.) x y)
 121   x `xor` y     = to (binop xor x y)
 122   complement    = to . complement . from
 123   x `shift` i   = to (from x `shift` i)
 124 --  rotate
 125   bit           = to . bit
 126   setBit x i    = to (setBit (from x) i)
 127   clearBit x i  = to (clearBit (from x) i)
 128   complementBit x i = to (complementBit (from x) i)
 129   testBit x i   = testBit (from x) i
 130   bitSize  _    = 8
 131   isSigned _    = False
 132
 133 -----------------------------------------------------------------------------
 134 -- Word16
 135 -----------------------------------------------------------------------------
 136
 137 newtype Word16 = W16 Word32
 138
 139 word16ToWord32 (W16 x) = x .&. 0xffff
 140 word32ToWord16 = W16
 141
 142 instance Eq  Word16     where (==)    = binop (==)
 143 instance Ord Word16     where compare = binop compare
 144
 145 instance Num Word16 where
 146     x + y         = to (binop (+) x y)
 147     x - y         = to (binop (-) x y)
 148     negate        = to . negate . from
 149     x * y         = to (binop (*) x y)
 150     abs x         = x
 151     signum        = signumReal
 152     fromInteger   = to . integer2Word
 153     fromInt       = intToWord16
 154
 155 instance Bounded Word16 where
 156     minBound = 0
 157     maxBound = 0xffff
 158
 159 instance Real Word16 where
 160   toRational x = toInteger x % 1
 161
 162 instance Integral Word16 where
 163   x `div` y     = to  (binop div x y)
 164   x `quot` y    = to  (binop quot x y)
 165   x `rem` y     = to  (binop rem x y)
 166   x `mod` y     = to  (binop mod x y)
 167   x `quotRem` y = to2 (binop quotRem x y)
 168   divMod        = quotRem
 169   toInteger     = toInteger . from
 170   toInt         = word16ToInt
 171
 172 instance Ix Word16 where
 173   range (m,n)          = [m..n]
 174   index b@(m,n) i
 175          | inRange b i = word32ToInt (from (i - m))
 176          | otherwise   = error "index: Index out of range"
 177   inRange (m,n) i      = m <= i && i <= n
 178
 179 instance Enum Word16 where
 180   toEnum         = to . intToWord32
 181   fromEnum       = word32ToInt . from
 182   enumFrom c       = map toEnum [fromEnum c .. fromEnum (maxBound::Word16)]
 183   enumFromThen c d = map toEnum [fromEnum c, fromEnum d .. fromEnum (last::Word16)]
 184                        where last = if d < c then minBound else maxBound
 185
 186 instance Read Word16 where
 187   readsPrec p = readDec
 188
 189 instance Show Word16 where
 190   showsPrec p = showInt
 191
 192 instance Bits Word16 where
 193   x .&. y       = to (binop (.&.) x y)
 194   x .|. y       = to (binop (.|.) x y)
 195   x `xor` y     = to (binop xor x y)
 196   complement    = to . complement . from
 197   x `shift` i   = to (from x `shift` i)
 198 --  rotate
 199   bit           = to . bit
 200   setBit x i    = to (setBit (from x) i)
 201   clearBit x i  = to (clearBit (from x) i)
 202   complementBit x i = to (complementBit (from x) i)
 203   testBit x i   = testBit (from x) i
 204   bitSize  _    = 16
 205   isSigned _    = False
 206
 207 -----------------------------------------------------------------------------
 208 -- Word32
 209 --
 210 -- This code assumes that Word# is 32-bits - which is true on a 32-bit
 211 -- architecture, but will need to be updated for 64-bit architectures.
 212 -----------------------------------------------------------------------------
 213
 214 data Word32 = W32# Word# deriving (Eq, Ord)
 215
 216 instance Num Word32 where
 217     (+) = intop (+)
 218     (-) = intop (-)
 219     (*) = intop (*)
 220     negate (W32# x) = W32# (int2Word# (negateInt# (word2Int# x)))
 221     abs x           = x
 222     signum          = signumReal
 223     fromInteger     = integer2Word
 224     fromInt (I# x)  = W32# (int2Word# x)
 225
 226 {-# INLINE intop #-}
 227 intop op x y = intToWord32 (word32ToInt x `op` word32ToInt y)
 228
 229 instance Bounded Word32 where
 230     minBound = 0
 231     maxBound = minBound - 1
 232
 233 instance Real Word32 where
 234     toRational x = toInteger x % 1
 235
 236 instance Integral Word32 where
 237     x `div` y   = if x > 0 && y < 0     then quotWord (x-y-1) y
 238                   else if x < 0 && y > 0        then quotWord (x-y+1) y
 239                   else quotWord x y
 240     quot        =  quotWord
 241     rem         =  remWord
 242     x `mod` y = if x > 0 && y < 0 || x < 0 && y > 0 then
 243                     if r/=0 then r+y else 0
 244                 else
 245                     r
 246               where r = remWord x y
 247     a `quotRem` b    = (a `quot` b, a `rem` b)
 248     divMod x y       = (x `div` y,  x `mod` y)
 249     toInteger (W32# x) = int2Integer# (word2Int# x)
 250     toInt     (W32# x) = I# (word2Int# x)
 251
 252 {-# INLINE quotWord #-}
 253 {-# INLINE remWord  #-}
 254 (W32# x) `quotWord` (W32# y) = W32# (x `quotWord#` y)
 255 (W32# x) `remWord`  (W32# y) = W32# (x `remWord#`  y)
 256
 257 instance Ix Word32 where
 258     range (m,n)          = [m..n]
 259     index b@(m,n) i
 260            | inRange b i = word32ToInt (i - m)
 261            | otherwise   = error "index: Index out of range"
 262     inRange (m,n) i      = m <= i && i <= n
 263
 264 instance Enum Word32 where
 265     toEnum        = intToWord32
 266     fromEnum      = word32ToInt
 267     enumFrom c       = map toEnum [fromEnum c .. fromEnum (maxBound::Word32)]
 268     enumFromThen c d = map toEnum [fromEnum c, fromEnum d .. fromEnum (last::Word32)]
 269                        where last = if d < c then minBound else maxBound
 270
 271 instance Read Word32 where
 272     readsPrec p = readDec
 273
 274 instance Show Word32 where
 275     showsPrec p = showInt
 276
 277 instance Bits Word32 where
 278   (.&.)         = wordop and#
 279   (.|.)         = wordop or#
 280   xor           = wordop xor#
 281   complement x  = x `xor` maxBound
 282   shift (W32# x) i@(I# i#)
 283         | i > 0     = W32# (shiftL# x i#)
 284         | otherwise = W32# (shiftRA# x (negateInt# i#))
 285   --rotate
 286   bit i             = 1 `shift` i
 287   setBit x i        = x .|. bit i
 288   clearBit x i      = x .&. complement (bit i)
 289   complementBit x i = x `xor` bit i
 290   testBit x i       = (x .&. bit i) /= 0
 291   bitSize  _        = 32
 292   isSigned _        = False
 293
 294 {-# INLINE wordop #-}
 295 wordop op (W32# x) (W32# y) = W32# (x `op` y)
 296
 297 -----------------------------------------------------------------------------
 298 -- Word64
 299 -----------------------------------------------------------------------------
 300
 301 data Word64 = W64 {lo,hi::Word32} deriving (Eq, Ord, Bounded)
 302
 303 w64ToInteger W64{lo,hi} = toInteger lo + 0x100000000 * toInteger hi
 304 integerToW64 x = case x `quotRem` 0x100000000 of
 305                  (h,l) -> W64{lo=fromInteger l, hi=fromInteger h}
 306
 307 instance Show Word64 where
 308   showsPrec p x = showsPrec p (w64ToInteger x)
 309
 310 instance Read Word64 where
 311   readsPrec p s = [ (integerToW64 x,r) | (x,r) <- readDec s ]
 312
 313 -----------------------------------------------------------------------------
 314 -- End of exported definitions
 315 --
 316 -- The remainder of this file consists of definitions which are only
 317 -- used in the implementation.
 318 -----------------------------------------------------------------------------
 319
 320 -----------------------------------------------------------------------------
 321 -- Coercions - used to make the instance declarations more uniform
 322 -----------------------------------------------------------------------------
 323
 324 class Coerce a where
 325   to   :: Word32 -> a
 326   from :: a -> Word32
 327
 328 instance Coerce Word8 where
 329   from = word8ToWord32
 330   to   = word32ToWord8
 331
 332 instance Coerce Word16 where
 333   from = word16ToWord32
 334   to   = word32ToWord16
 335
 336 binop :: Coerce word => (Word32 -> Word32 -> a) -> (word -> word -> a)
 337 binop op x y = from x `op` from y
 338
 339 to2 :: Coerce word => (Word32, Word32) -> (word, word)
 340 to2 (x,y) = (to x, to y)
 341
 342 integer2Word (J# a# s# d#) = W32# (int2Word# (integer2Int# a# s# d#))
 343
 344 -----------------------------------------------------------------------------
 345 -- Code copied from the Prelude
 346 -----------------------------------------------------------------------------
 347
 348 signumReal x | x == 0    =  0
 349              | x > 0     =  1
 350              | otherwise = -1
 351
 352 -- showInt is used for positive numbers only
 353 -- stolen from Hugs prelude --SDM
 354 showInt    :: Integral a => a -> ShowS
 355 showInt n r | n < 0 = error "Word.showInt: can't show negative numbers"
 356             | otherwise =
 357               let (n',d) = quotRem n 10
 358                   r'     = toEnum (fromEnum '0' + fromIntegral d) : r
 359               in  if n' == 0 then r' else showInt n' r'
 360
 361 \end{code}