ghc/interpreter/library/Word.hs

   1 -----------------------------------------------------------------------------
   2 -- Unsigned Integers
   3 -- Suitable for use with Hugs 1.4 on 32 bit systems.
   4 -----------------------------------------------------------------------------
   5 module Word
   6         ( Word8
   7         , Word16
   8         , Word32
   9         , Word64
  10         , word8ToWord32  -- :: Word8  -> Word32
  11         , word32ToWord8  -- :: Word32 -> Word8
  12         , word16ToWord32 -- :: Word16 -> Word32
  13         , word32ToWord16 -- :: Word32 -> Word16
  14         , word8ToInt     -- :: Word8  -> Int
  15         , intToWord8     -- :: Int    -> Word8
  16         , word16ToInt    -- :: Word16 -> Int
  17         , intToWord16    -- :: Int    -> Word16
  18         , word32ToInt    -- :: Word32 -> Int
  19         , intToWord32    -- :: Int    -> Word32
  20         ) where
  21
  22 import PreludeBuiltin
  23 import Bits
  24
  25 -----------------------------------------------------------------------------
  26 -- The "official" coercion functions
  27 -----------------------------------------------------------------------------
  28
  29 word8ToWord32  :: Word8  -> Word32
  30 word32ToWord8  :: Word32 -> Word8
  31 word16ToWord32 :: Word16 -> Word32
  32 word32ToWord16 :: Word32 -> Word16
  33
  34 word8ToInt   :: Word8  -> Int
  35 intToWord8   :: Int    -> Word8
  36 word16ToInt  :: Word16 -> Int
  37 intToWord16  :: Int    -> Word16
  38 word32ToInt :: Word32 -> Int
  39 intToWord32 :: Int    -> Word32
  40
  41 word8ToInt  = word32ToInt    . word8ToWord32
  42 intToWord8  = word32ToWord8  . intToWord32
  43 word16ToInt = word32ToInt    . word16ToWord32
  44 intToWord16 = word32ToWord16 . intToWord32
  45
  46 word32ToInt (W32 x) = primWordToInt x
  47 intToWord32 x       = W32 (primIntToWord x)
  48
  49
  50 -----------------------------------------------------------------------------
  51 -- Word8
  52 -----------------------------------------------------------------------------
  53
  54 newtype Word8  = W8 Word32
  55
  56 word8ToWord32 (W8 x) = x .&. 0xff
  57 word32ToWord8 = W8
  58
  59 instance Eq  Word8     where (==)    = binop (==)
  60 instance Ord Word8     where compare = binop compare
  61
  62 instance Num Word8 where
  63     x + y         = to (binop (+) x y)
  64     x - y         = to (binop (-) x y)
  65     negate        = to . negate . from
  66     x * y         = to (binop (*) x y)
  67     abs           = absReal
  68     signum        = signumReal
  69     fromInteger   = to . fromInteger
  70     fromInt       = intToWord8
  71
  72 instance Bounded Word8 where
  73     minBound = 0
  74     maxBound = 0xff
  75
  76 instance Real Word8 where
  77     toRational x = toInteger x % 1
  78
  79 instance Integral Word8 where
  80     x `div` y     = to  (binop div x y)
  81     x `quot` y    = to  (binop quot x y)
  82     x `rem` y     = to  (binop rem x y)
  83     x `mod` y     = to  (binop mod x y)
  84     x `quotRem` y = to2 (binop quotRem x y)
  85     divMod        = quotRem
  86     toInteger     = toInteger . from
  87     toInt         = word8ToInt
  88
  89 instance Ix Word8 where
  90     range (m,n)          = [m..n]
  91     index b@(m,n) i
  92            | inRange b i = word32ToInt (from (i - m))
  93            | otherwise   = error "index: Index out of range"
  94     inRange (m,n) i      = m <= i && i <= n
  95
  96 instance Enum Word8 where
  97     toEnum         = to . intToWord32
  98     fromEnum       = word32ToInt . from
  99     enumFrom c       = map toEnum [fromEnum c .. fromEnum (maxBound::Word8)]
 100     enumFromThen c d = map toEnum [fromEnum c, fromEnum d .. fromEnum (last::Word8)]
 101                        where last = if d < c then minBound else maxBound
 102
 103 instance Read Word8 where
 104     readsPrec p = readDec
 105
 106 instance Show Word8 where
 107     showsPrec p = showInt . toInteger -- a particularily counterintuitive name!
 108
 109 instance Bits Word8 where
 110   x .&. y       = to (binop (.&.) x y)
 111   x .|. y       = to (binop (.|.) x y)
 112   x `xor` y     = to (binop xor x y)
 113   complement    = to . complement . from
 114   x `shift` i   = to (from x `shift` i)
 115 --  rotate
 116   bit           = to . bit
 117   setBit x i    = to (setBit (from x) i)
 118   clearBit x i  = to (clearBit (from x) i)
 119   complementBit x i = to (complementBit (from x) i)
 120   testBit x i   = testBit (from x) i
 121   bitSize  _    = 8
 122   isSigned _    = False
 123
 124 -----------------------------------------------------------------------------
 125 -- Word16
 126 -----------------------------------------------------------------------------
 127
 128 newtype Word16 = W16 Word32
 129
 130 word16ToWord32 (W16 x) = x .&. 0xffff
 131 word32ToWord16 = W16
 132
 133 instance Eq  Word16     where (==)    = binop (==)
 134 instance Ord Word16     where compare = binop compare
 135
 136 instance Num Word16 where
 137     x + y         = to (binop (+) x y)
 138     x - y         = to (binop (-) x y)
 139     negate        = to . negate . from
 140     x * y         = to (binop (*) x y)
 141     abs           = absReal
 142     signum        = signumReal
 143     fromInteger   = to . fromInteger
 144     fromInt       = intToWord16
 145
 146 instance Bounded Word16 where
 147     minBound = 0
 148     maxBound = 0xffff
 149
 150 instance Real Word16 where
 151   toRational x = toInteger x % 1
 152
 153 instance Integral Word16 where
 154   x `div` y     = to  (binop div x y)
 155   x `quot` y    = to  (binop quot x y)
 156   x `rem` y     = to  (binop rem x y)
 157   x `mod` y     = to  (binop mod x y)
 158   x `quotRem` y = to2 (binop quotRem x y)
 159   divMod        = quotRem
 160   toInteger     = toInteger . from
 161   toInt         = word16ToInt
 162
 163 instance Ix Word16 where
 164   range (m,n)          = [m..n]
 165   index b@(m,n) i
 166          | inRange b i = word32ToInt (from (i - m))
 167          | otherwise   = error "index: Index out of range"
 168   inRange (m,n) i      = m <= i && i <= n
 169
 170 instance Enum Word16 where
 171   toEnum         = to . intToWord32
 172   fromEnum       = word32ToInt . from
 173   enumFrom c       = map toEnum [fromEnum c .. fromEnum (maxBound::Word16)]
 174   enumFromThen c d = map toEnum [fromEnum c, fromEnum d .. fromEnum (last::Word16)]
 175                        where last = if d < c then minBound else maxBound
 176
 177 instance Read Word16 where
 178   readsPrec p = readDec
 179
 180 instance Show Word16 where
 181   showsPrec p = showInt . toInteger -- a particularily counterintuitive name!
 182
 183 instance Bits Word16 where
 184   x .&. y       = to (binop (.&.) x y)
 185   x .|. y       = to (binop (.|.) x y)
 186   x `xor` y     = to (binop xor x y)
 187   complement    = to . complement . from
 188   x `shift` i   = to (from x `shift` i)
 189 --  rotate
 190   bit           = to . bit
 191   setBit x i    = to (setBit (from x) i)
 192   clearBit x i  = to (clearBit (from x) i)
 193   complementBit x i = to (complementBit (from x) i)
 194   testBit x i   = testBit (from x) i
 195   bitSize  _    = 16
 196   isSigned _    = False
 197
 198 -----------------------------------------------------------------------------
 199 -- Word32
 200 -----------------------------------------------------------------------------
 201
 202 newtype Word32 = W32 Word
 203
 204 w32 :: Word32 -> Word
 205 w32 (W32 x) = x
 206
 207 lift0 :: Word -> Word32
 208 lift1 :: (Word -> Word) -> (Word32 -> Word32)
 209 lift2 :: (Word -> Word -> Word) -> (Word32 -> Word32 -> Word32)
 210 lift2' :: (Word -> Word -> (Word,Word)) -> (Word32 -> Word32 -> (Word32,Word32))
 211
 212 lift0 x                 = W32 x
 213 lift1 f (W32 x)         = W32 (f x)
 214 lift2 f (W32 x) (W32 y) = W32 (f x y)
 215
 216 lift2' f (W32 x) (W32 y) = case f x y of (a,b) -> (W32 a, W32 b)
 217
 218 instance Eq  Word32 where
 219   x == y  = primEqWord (w32 x) (w32 y)
 220   x /= y  = primNeWord (w32 x) (w32 y)
 221
 222 instance Ord Word32 where
 223   x <  y  = primLtWord (w32 x) (w32 y)
 224   x <= y  = primLeWord (w32 x) (w32 y)
 225   x >= y  = primGeWord (w32 x) (w32 y)
 226   x >  y  = primGtWord (w32 x) (w32 y)
 227
 228 instance Num Word32 where
 229     (+)         = lift2 primPlusWord
 230     (-)         = lift2 primMinusWord
 231     negate      = lift1 primNegateWord
 232     (*)         = lift2 primTimesWord
 233     abs         = id
 234     signum x    = if x == 0 then 0 else 1
 235     fromInteger = W32 . primIntegerToWord
 236     fromInt     = W32 . primIntToWord
 237
 238 instance Bounded Word32 where
 239     minBound = 0
 240     maxBound = W32 primMaxWord
 241
 242 instance Real Word32 where
 243     toRational x = toInteger x % 1
 244
 245 instance Integral Word32 where
 246     quotRem   = lift2' primQuotRemWord
 247     quot      = lift2  primQuotWord
 248     rem       = lift2  primRemWord
 249     divMod    = lift2' primQuotRemWord  -- no difference for unsigned values!
 250     div       = lift2  primQuotWord
 251     mod       = lift2  primRemWord
 252     toInteger = primWordToInteger . w32
 253     toInt     = primWordToInt     . w32
 254
 255 instance Ix Word32 where
 256     range (m,n)          = [m..n]
 257     index b@(m,n) i
 258            | inRange b i = word32ToInt (i - m)
 259            | otherwise   = error "index: Index out of range"
 260     inRange (m,n) i      = m <= i && i <= n
 261
 262 instance Enum Word32 where
 263     toEnum        = fromInt
 264     fromEnum      = toInt
 265
 266     enumFrom w              = [w .. maxBound]
 267     enumFromTo   w1 w2
 268       | w1 <= w2  = eft32 w1 w2
 269       | otherwise = []
 270     enumFromThen w1 w2      = [w1, w2 .. last]
 271         where
 272          last
 273           | w1 < w2   = maxBound::Word32
 274           | otherwise = minBound
 275     enumFromThenTo w1 w2 last = eftt32 w1 (w2 - w1) (>last)
 276
 277 --------------------------------
 278 -- Begin stolen from GHC (but then modified!)
 279 --------------------------------
 280
 281 -- Termination is easy because the step is 1
 282 eft32 :: Word32 -> Word32 -> [Word32]
 283 eft32 now last = go now
 284   where
 285    go x
 286     | x == last = [x]
 287     | otherwise = x : (go `strict` (x+1))
 288
 289 -- Termination is hard because the step is not 1
 290 -- Warning: this code is known not to work near maxBound
 291 eftt32 :: Word32 -> Word32 -> (Word32->Bool) -> [Word32]
 292 eftt32 now step done = go now
 293   where
 294    go now
 295      | done now  = []
 296      | otherwise = now : (go `strict` (now+step))
 297
 298 --------------------------------
 299 -- End stolen from GHC.
 300 --------------------------------
 301
 302 instance Read Word32 where
 303     readsPrec p = readDec
 304
 305 instance Show Word32 where
 306     showsPrec p = showInt . toInteger -- a particularily counterintuitive name!
 307
 308 instance Bits Word32 where
 309   (.&.)         = lift2 primAndWord
 310   (.|.)         = lift2 primOrWord
 311   xor           = lift2 primXorWord
 312   complement    = lift1 primNotWord
 313   shift x n
 314     | n >= 0    = W32 (primShiftLWord  (w32 x) (primIntToWord n))
 315     | otherwise = W32 (primShiftRLWord (w32 x) (primIntToWord (-n)))
 316 --  rotate
 317   bit           = shift 1
 318   setBit x i    = x .|. bit i
 319   clearBit x i  = x .&. complement (bit i)
 320   complementBit x i = x `xor` bit i
 321   testBit x i   = x .&. bit i /= 0
 322   bitSize  _    = 32
 323   isSigned _    = False
 324
 325 -----------------------------------------------------------------------------
 326 -- Word64
 327 -----------------------------------------------------------------------------
 328
 329 data Word64 = W64 {lo,hi::Word32} deriving (Eq, Ord, Bounded)
 330
 331 w64ToInteger W64{lo,hi} = toInteger lo + 0x100000000 * toInteger hi
 332 integerToW64 x = case x `quotRem` 0x100000000 of
 333                  (h,l) -> W64{lo=fromInteger l, hi=fromInteger h}
 334
 335 instance Show Word64 where
 336   showsPrec p = showInt . w64ToInteger
 337
 338 instance Read Word64 where
 339   readsPrec p s = [ (integerToW64 x,r) | (x,r) <- readDec s ]
 340
 341 -----------------------------------------------------------------------------
 342 -- End of exported definitions
 343 --
 344 -- The remainder of this file consists of definitions which are only
 345 -- used in the implementation.
 346 -----------------------------------------------------------------------------
 347
 348 -----------------------------------------------------------------------------
 349 -- Enumeration code: copied from Prelude
 350 -----------------------------------------------------------------------------
 351
 352 numericEnumFrom        :: Real a => a -> [a]
 353 numericEnumFromThen    :: Real a => a -> a -> [a]
 354 numericEnumFromTo      :: Real a => a -> a -> [a]
 355 numericEnumFromThenTo  :: Real a => a -> a -> a -> [a]
 356 numericEnumFrom n            = n : strict numericEnumFrom (n+1)
 357 numericEnumFromThen n m      = iterate ((m-n)+) n
 358 numericEnumFromTo n m        = takeWhile (<= m) (numericEnumFrom n)
 359 numericEnumFromThenTo n n' m = takeWhile (if n' >= n then (<= m) else (>= m))
 360                                          (numericEnumFromThen n n')
 361
 362 -----------------------------------------------------------------------------
 363 -- Coercions - used to make the instance declarations more uniform
 364 -----------------------------------------------------------------------------
 365
 366 class Coerce a where
 367   to   :: Word32 -> a
 368   from :: a -> Word32
 369
 370 instance Coerce Word8 where
 371   from = word8ToWord32
 372   to   = word32ToWord8
 373
 374 instance Coerce Word16 where
 375   from = word16ToWord32
 376   to   = word32ToWord16
 377
 378 binop :: Coerce word => (Word32 -> Word32 -> a) -> (word -> word -> a)
 379 binop op x y = from x `op` from y
 380
 381 to2 :: Coerce word => (Word32, Word32) -> (word, word)
 382 to2 (x,y) = (to x, to y)
 383
 384 -----------------------------------------------------------------------------
 385 -- Code copied from the Prelude
 386 -----------------------------------------------------------------------------
 387
 388 absReal x    | x >= 0    = x
 389              | otherwise = -x
 390
 391 signumReal x | x == 0    =  0
 392              | x > 0     =  1
 393              | otherwise = -1
 394
 395 -----------------------------------------------------------------------------
 396 -- End
 397 -----------------------------------------------------------------------------