ghc/lib/exts/Word.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1997
   3 %
   4 \section[Word]{Module @Word@}
   5
   6 GHC implementation of the standard Hugs/GHC @Word@
   7 interface, types and operations over unsigned, sized
   8 quantities.
   9
  10 \begin{code}
  11 #include "MachDeps.h"
  12
  13 module Word
  14         ( Word8          -- all abstract.
  15         , Word16         -- instances: Eq, Ord
  16         , Word32         --  Num, Bounded, Real,
  17         , Word64         --  Integral, Ix, Enum,
  18                          --  Read, Show, Bits,
  19                          --  CCallable, CReturnable
  20                          --  (last two
  21
  22         , word8ToWord32   -- :: Word8  -> Word32
  23         , word32ToWord8   -- :: Word32 -> Word8
  24         , word16ToWord32  -- :: Word16 -> Word32
  25         , word32ToWord16  -- :: Word32 -> Word16
  26
  27         , word8ToInt      -- :: Word8  -> Int
  28         , intToWord8      -- :: Int    -> Word8
  29         , word16ToInt     -- :: Word16 -> Int
  30         , intToWord16     -- :: Int    -> Word16
  31         , word32ToInt     -- :: Word32 -> Int
  32         , intToWord32     -- :: Int    -> Word32
  33
  34         , word32ToWord64  -- :: Word32 -> Word64
  35         , word64ToWord32  -- :: Word64 -> Word32
  36
  37         , word64ToInteger -- :: Word64  -> Integer
  38         , integerToWord64 -- :: Integer -> Word64
  39
  40         -- NB! GHC SPECIFIC:
  41         , wordToWord8     -- :: Word -> Word8
  42         , word8ToWord     -- :: Word8 -> Word
  43         , wordToWord16    -- :: Word -> Word16
  44         , word16ToWord    -- :: Word16 -> Word
  45         , wordToWord32    -- :: Word -> Word32
  46         , word32ToWord    -- :: Word32 -> Word
  47
  48         -- The "official" place to get these from is Addr.
  49         , indexWord8OffAddr
  50         , indexWord16OffAddr
  51         , indexWord32OffAddr
  52         , indexWord64OffAddr
  53
  54         , readWord8OffAddr
  55         , readWord16OffAddr
  56         , readWord32OffAddr
  57         , readWord64OffAddr
  58
  59         , writeWord8OffAddr
  60         , writeWord16OffAddr
  61         , writeWord32OffAddr
  62         , writeWord64OffAddr
  63
  64         , sizeofWord8
  65         , sizeofWord16
  66         , sizeofWord32
  67         , sizeofWord64
  68
  69         -- non-standard, GHC specific
  70         , wordToInt
  71
  72         ) where
  73
  74 import GlaExts
  75 import Ix
  76 import Bits
  77 import CCall
  78 import Numeric (readDec, showInt)
  79
  80 -----------------------------------------------------------------------------
  81 -- The "official" coercion functions
  82 -----------------------------------------------------------------------------
  83
  84 word8ToWord32  :: Word8  -> Word32
  85 word32ToWord8  :: Word32 -> Word8
  86 word16ToWord32 :: Word16 -> Word32
  87 word32ToWord16 :: Word32 -> Word16
  88
  89 word8ToInt   :: Word8  -> Int
  90 intToWord8   :: Int    -> Word8
  91 word16ToInt  :: Word16 -> Int
  92 intToWord16  :: Int    -> Word16
  93
  94 word8ToInt  = word32ToInt    . word8ToWord32
  95 intToWord8  = word32ToWord8  . intToWord32
  96 word16ToInt = word32ToInt    . word16ToWord32
  97 intToWord16 = word32ToWord16 . intToWord32
  98
  99 intToWord32 (I# x)   = W32# ((int2Word# x) `and#` (case (maxBound::Word32) of W32# x# -> x#))
 100 --intToWord32 (I# x)   = W32# (int2Word# x)
 101 word32ToInt (W32# x) = I#   (word2Int# x)
 102
 103 wordToInt :: Word -> Int
 104 wordToInt (W# w#) = I# (word2Int# w#)
 105
 106 \end{code}
 107
 108 \subsection[Word8]{The @Word8@ interface}
 109
 110 The byte type @Word8@ is represented in the Haskell
 111 heap by boxing up a 32-bit quantity, @Word#@. An invariant
 112 for this representation is that the higher 24 bits are
 113 *always* zeroed out. A consequence of this is that
 114 operations that could possibly overflow have to mask
 115 out the top three bytes before building the resulting @Word8@.
 116
 117 \begin{code}
 118 data Word8  = W8# Word#
 119
 120 instance CCallable Word8
 121 instance CReturnable Word8
 122
 123 word8ToWord32 (W8#  x) = W32# x
 124 word32ToWord8 (W32# x) = W8# (wordToWord8# x)
 125
 126 -- mask out upper three bytes.
 127 intToWord8# :: Int# -> Word#
 128 intToWord8# i# = (int2Word# i#) `and#` (int2Word# 0xff#)
 129
 130 wordToWord8# :: Word# -> Word#
 131 wordToWord8# w# = w# `and#` (int2Word# 0xff#)
 132
 133 instance Eq  Word8     where
 134   (W8# x) == (W8# y) = x `eqWord#` y
 135   (W8# x) /= (W8# y) = x `neWord#` y
 136
 137 instance Ord Word8     where
 138   compare (W8# x#) (W8# y#) = compareWord# x# y#
 139   (<)  (W8# x) (W8# y)      = x `ltWord#` y
 140   (<=) (W8# x) (W8# y)      = x `leWord#` y
 141   (>=) (W8# x) (W8# y)      = x `geWord#` y
 142   (>)  (W8# x) (W8# y)      = x `gtWord#` y
 143   max x@(W8# x#) y@(W8# y#) =
 144      case (compareWord# x# y#) of { LT -> y ; EQ -> x ; GT -> x }
 145   min x@(W8# x#) y@(W8# y#) =
 146      case (compareWord# x# y#) of { LT -> x ; EQ -> x ; GT -> y }
 147
 148 -- Helper function, used by Ord Word* instances.
 149 compareWord# :: Word# -> Word# -> Ordering
 150 compareWord# x# y#
 151  | x# `ltWord#` y# = LT
 152  | x# `eqWord#` y# = EQ
 153  | otherwise       = GT
 154
 155 instance Num Word8 where
 156   (W8# x) + (W8# y) =
 157       W8# (intToWord8# (word2Int# x +# word2Int# y))
 158   (W8# x) - (W8# y) =
 159       W8# (intToWord8# (word2Int# x -# word2Int# y))
 160   (W8# x) * (W8# y) =
 161       W8# (intToWord8# (word2Int# x *# word2Int# y))
 162   negate w@(W8# x)  =
 163      if x' ==# 0#
 164       then w
 165       else W8# (int2Word# (0x100# -# x'))
 166      where
 167       x' = word2Int# x
 168   abs x         = x
 169   signum        = signumReal
 170   fromInteger (J# a# s# d#) = W8# (wordToWord8# (integer2Word# a# s# d#))
 171   fromInt       = intToWord8
 172
 173 instance Bounded Word8 where
 174   minBound = 0
 175   maxBound = 0xff
 176
 177 instance Real Word8 where
 178   toRational x = toInteger x % 1
 179
 180 -- Note: no need to mask results here
 181 -- as they cannot overflow.
 182 instance Integral Word8 where
 183   div  (W8# x)  (W8# y)   = W8# (x `quotWord#` y)
 184   quot (W8# x)  (W8# y)   = W8# (x `quotWord#` y)
 185   rem  (W8# x)  (W8# y)   = W8# (x `remWord#` y)
 186   mod  (W8# x)  (W8# y)   = W8# (x `remWord#` y)
 187   quotRem (W8# x) (W8# y) = (W8# (x `quotWord#` y), W8# (x `remWord#` y))
 188   divMod  (W8# x) (W8# y) = (W8# (x `quotWord#` y), W8# (x `remWord#` y))
 189   toInteger (W8# x)       = word2Integer# x
 190   toInt x                 = word8ToInt x
 191
 192 instance Ix Word8 where
 193     range (m,n)          = [m..n]
 194     index b@(m,n) i
 195            | inRange b i = word8ToInt (i-m)
 196            | otherwise   = error (showString "Ix{Word8}.index: Index " .
 197                                   showParen True (showsPrec 0 i) .
 198                                   showString " out of range " $
 199                                   showParen True (showsPrec 0 b) "")
 200     inRange (m,n) i      = m <= i && i <= n
 201
 202 instance Enum Word8 where
 203     toEnum    (I# i)  = W8# (intToWord8# i)
 204     fromEnum  (W8# w) = I# (word2Int# w)
 205     enumFrom c       = map toEnum [fromEnum c .. fromEnum (maxBound::Word8)]
 206     enumFromThen c d = map toEnum [fromEnum c, fromEnum d .. fromEnum (last::Word8)]
 207                        where last = if d < c then minBound else maxBound
 208
 209 instance Read Word8 where
 210     readsPrec p = readDec
 211
 212 instance Show Word8 where
 213     showsPrec p = showInt
 214
 215 --
 216 -- Word8s are represented by an (unboxed) 32-bit Word.
 217 -- The invariant is that the upper 24 bits are always zeroed out.
 218 --
 219 instance Bits Word8 where
 220   (W8# x)  .&.  (W8# y)    = W8# (x `and#` y)
 221   (W8# x)  .|.  (W8# y)    = W8# (x `or#` y)
 222   (W8# x) `xor` (W8# y)    = W8# (x `xor#` y)
 223   complement (W8# x)       = W8# (x `xor#` int2Word# 0xff#)
 224   shift (W8# x#) i@(I# i#)
 225         | i > 0     = W8# (wordToWord8# (shiftL# x# i#))
 226         | otherwise = W8# (wordToWord8# (shiftRL# x# (negateInt# i#)))
 227   w@(W8# x)  `rotate` (I# i)
 228         | i ==# 0#    = w
 229         | i ># 0#     = W8# ((wordToWord8# (shiftL# x i')) `or#`
 230                              (shiftRL# (x `and#`
 231                                         (int2Word# (0x100# -# pow2# i2)))
 232                                        i2))
 233         | otherwise = rotate w (I# (8# +# i))
 234           where
 235            i' = word2Int# (int2Word# i `and#` int2Word# 7#)
 236            i2 = 8# -# i'
 237
 238   bit (I# i#)
 239         | i# >=# 0# && i# <=# 7# = W8# (wordToWord8# (shiftL# (int2Word# 1#) i#))
 240         | otherwise = 0 -- We'll be overbearing, for now..
 241
 242   setBit x i    = x .|. bit i
 243   clearBit x i  = x .&. complement (bit i)
 244   complementBit x i = x `xor` bit i
 245
 246   testBit (W8# x#) (I# i#)
 247     | i# <# 8# && i# >=# 0# = (word2Int# (x# `and#` (shiftL# (int2Word# 1#) i#))) /=# 0#
 248     | otherwise             = False -- for now, this is really an error.
 249
 250   bitSize  _    = 8
 251   isSigned _    = False
 252
 253 pow2# :: Int# -> Int#
 254 pow2# x# = word2Int# (shiftL# (int2Word# 1#) x#)
 255
 256 sizeofWord8 :: Word32
 257 sizeofWord8 = 1
 258
 259 \end{code}
 260
 261 \subsection[Word16]{The @Word16@ interface}
 262
 263 The double byte type @Word16@ is represented in the Haskell
 264 heap by boxing up a machine word, @Word#@. An invariant
 265 for this representation is that only the lower 16 bits are
 266 `active', any bits above are {\em always} zeroed out.
 267 A consequence of this is that operations that could possibly
 268 overflow have to mask out anything above the lower two bytes
 269 before putting together the resulting @Word16@.
 270
 271 \begin{code}
 272 data Word16 = W16# Word#
 273 instance CCallable Word16
 274 instance CReturnable Word16
 275
 276 word16ToWord32 (W16# x) = W32# x
 277 word32ToWord16 (W32# x) = W16# (wordToWord16# x)
 278
 279 -- mask out upper 16 bits.
 280 intToWord16# :: Int# -> Word#
 281 intToWord16# i# = ((int2Word# i#) `and#` (int2Word# 0xffff#))
 282
 283 wordToWord16# :: Word# -> Word#
 284 wordToWord16# w# = w# `and#` (int2Word# 0xffff#)
 285
 286 instance Eq  Word16    where
 287   (W16# x) == (W16# y) = x `eqWord#` y
 288   (W16# x) /= (W16# y) = x `neWord#` y
 289
 290 instance Ord Word16     where
 291   compare (W16# x#) (W16# y#) = compareWord# x# y#
 292   (<)  (W16# x) (W16# y)      = x `ltWord#` y
 293   (<=) (W16# x) (W16# y)      = x `leWord#` y
 294   (>=) (W16# x) (W16# y)      = x `geWord#` y
 295   (>)  (W16# x) (W16# y)      = x `gtWord#` y
 296   max x@(W16# x#) y@(W16# y#) =
 297      case (compareWord# x# y#) of { LT -> y ; EQ -> x ; GT -> x }
 298   min x@(W16# x#) y@(W16# y#) =
 299      case (compareWord# x# y#) of { LT -> x ; EQ -> x ; GT -> y }
 300
 301 instance Num Word16 where
 302   (W16# x) + (W16# y) =
 303        W16# (intToWord16# (word2Int# x +# word2Int# y))
 304   (W16# x) - (W16# y) =
 305        W16# (intToWord16# (word2Int# x -# word2Int# y))
 306   (W16# x) * (W16# y) =
 307        W16# (intToWord16# (word2Int# x *# word2Int# y))
 308   negate w@(W16# x)  =
 309        if x' ==# 0#
 310         then w
 311         else W16# (int2Word# (0x10000# -# x'))
 312        where
 313         x' = word2Int# x
 314   abs x         = x
 315   signum        = signumReal
 316   fromInteger (J# a# s# d#) = W16# (wordToWord16# (integer2Word# a# s# d#))
 317   fromInt       = intToWord16
 318
 319 instance Bounded Word16 where
 320   minBound = 0
 321   maxBound = 0xffff
 322
 323 instance Real Word16 where
 324   toRational x = toInteger x % 1
 325
 326 instance Integral Word16 where
 327   div  (W16# x)  (W16# y)   = W16# (x `quotWord#` y)
 328   quot (W16# x)  (W16# y)   = W16# (x `quotWord#` y)
 329   rem  (W16# x)  (W16# y)   = W16# (x `remWord#` y)
 330   mod  (W16# x)  (W16# y)   = W16# (x `remWord#` y)
 331   quotRem (W16# x) (W16# y) = (W16# (x `quotWord#` y), W16# (x `remWord#` y))
 332   divMod  (W16# x) (W16# y) = (W16# (x `quotWord#` y), W16# (x `remWord#` y))
 333   toInteger (W16# x)        = word2Integer# x
 334   toInt x                   = word16ToInt x
 335
 336 instance Ix Word16 where
 337   range (m,n)          = [m..n]
 338   index b@(m,n) i
 339          | inRange b i = word16ToInt (i - m)
 340          | otherwise   = error (showString "Ix{Word16}.index: Index " .
 341                                 showParen True (showsPrec 0 i) .
 342                                 showString " out of range " $
 343                                 showParen True (showsPrec 0 b) "")
 344   inRange (m,n) i      = m <= i && i <= n
 345
 346 instance Enum Word16 where
 347   toEnum    (I# i)   = W16# (intToWord16# i)
 348   fromEnum  (W16# w) = I# (word2Int# w)
 349   enumFrom c       = map toEnum [fromEnum c .. fromEnum (maxBound::Word16)]
 350   enumFromThen c d = map toEnum [fromEnum c, fromEnum d .. fromEnum (last::Word16)]
 351                        where last = if d < c then minBound else maxBound
 352
 353 instance Read Word16 where
 354   readsPrec p = readDec
 355
 356 instance Show Word16 where
 357   showsPrec p = showInt
 358
 359 instance Bits Word16 where
 360   (W16# x)  .&.  (W16# y)  = W16# (x `and#` y)
 361   (W16# x)  .|.  (W16# y)  = W16# (x `or#` y)
 362   (W16# x) `xor` (W16# y)  = W16# (x `xor#` y)
 363   complement (W16# x)      = W16# (x `xor#` int2Word# 0xffff#)
 364   shift (W16# x#) i@(I# i#)
 365         | i > 0     = W16# (wordToWord16# (shiftL# x# i#))
 366         | otherwise = W16# (shiftRL# x# (negateInt# i#))
 367   w@(W16# x)  `rotate` (I# i)
 368         | i ==# 0#    = w
 369         | i ># 0#     = W16# ((wordToWord16# (shiftL# x i')) `or#`
 370                               (shiftRL# (x `and#`
 371                                          (int2Word# (0x10000# -# pow2# i2)))
 372                                         i2))
 373         | otherwise = rotate w (I# (16# +# i'))
 374           where
 375            i' = word2Int# (int2Word# i `and#` int2Word# 15#)
 376            i2 = 16# -# i'
 377   bit (I# i#)
 378         | i# >=# 0# && i# <=# 15# = W16# (shiftL# (int2Word# 1#) i#)
 379         | otherwise = 0 -- We'll be overbearing, for now..
 380
 381   setBit x i    = x .|. bit i
 382   clearBit x i  = x .&. complement (bit i)
 383   complementBit x i = x `xor` bit i
 384
 385   testBit (W16# x#) (I# i#)
 386     | i# <# 16# && i# >=# 0# = (word2Int# (x# `and#` (shiftL# (int2Word# 1#) i#))) /=# 0#
 387     | otherwise             = False -- for now, this is really an error.
 388
 389   bitSize  _    = 16
 390   isSigned _    = False
 391
 392
 393 sizeofWord16 :: Word32
 394 sizeofWord16 = 2
 395
 396 \end{code}
 397
 398 \subsection[Word32]{The @Word32@ interface}
 399
 400 The quad byte type @Word32@ is represented in the Haskell
 401 heap by boxing up a machine word, @Word#@. An invariant
 402 for this representation is that any bits above the lower
 403 32 are {\em always} zeroed out. A consequence of this is that
 404 operations that could possibly overflow have to mask
 405 the result before building the resulting @Word16@.
 406
 407 \begin{code}
 408 data Word32 = W32# Word#
 409
 410 instance CCallable Word32
 411 instance CReturnable Word32
 412
 413 instance Eq  Word32    where
 414   (W32# x) == (W32# y) = x `eqWord#` y
 415   (W32# x) /= (W32# y) = x `neWord#` y
 416
 417 instance Ord Word32    where
 418   compare (W32# x#) (W32# y#) = compareWord# x# y#
 419   (<)  (W32# x) (W32# y)      = x `ltWord#` y
 420   (<=) (W32# x) (W32# y)      = x `leWord#` y
 421   (>=) (W32# x) (W32# y)      = x `geWord#` y
 422   (>)  (W32# x) (W32# y)      = x `gtWord#` y
 423   max x@(W32# x#) y@(W32# y#) =
 424      case (compareWord# x# y#) of { LT -> y ; EQ -> x ; GT -> x }
 425   min x@(W32# x#) y@(W32# y#) =
 426      case (compareWord# x# y#) of { LT -> x ; EQ -> x ; GT -> y }
 427
 428 instance Num Word32 where
 429   (W32# x) + (W32# y) =
 430        W32# (intToWord32# (word2Int# x +# word2Int# y))
 431   (W32# x) - (W32# y) =
 432        W32# (intToWord32# (word2Int# x -# word2Int# y))
 433   (W32# x) * (W32# y) =
 434        W32# (intToWord32# (word2Int# x *# word2Int# y))
 435 #if WORD_SIZE_IN_BYTES == 8
 436   negate w@(W32# x)  =
 437       if x' ==# 0#
 438        then w
 439        else W32# (intToWord32# (0x100000000# -# x'))
 440        where
 441         x' = word2Int# x
 442 #else
 443   negate (W32# x)  = W32# (intToWord32# (negateInt# (word2Int# x)))
 444 #endif
 445   abs x           = x
 446   signum          = signumReal
 447   fromInteger (J# a# s# d#) = W32# (integer2Word# a# s# d#)
 448   fromInt (I# x)  = W32# (intToWord32# x)
 449     -- ToDo: restrict fromInt{eger} range.
 450
 451 intToWord32#  :: Int#  -> Word#
 452 wordToWord32# :: Word# -> Word#
 453
 454 #if WORD_SIZE_IN_BYTES == 8
 455 intToWord32#  i# = (int2Word# i#) `and#` (int2Word# 0xffffffff)
 456 wordToWord32# w# = w# `and#` (int2Word# 0xffffffff)
 457 wordToWord64# w# = w#
 458 #else
 459 intToWord32#  i# = int2Word# i#
 460 wordToWord32# w# = w#
 461
 462 #endif
 463
 464 instance Bounded Word32 where
 465     minBound = 0
 466 #if WORD_SIZE_IN_BYTES == 8
 467     maxBound = 0xffffffff
 468 #else
 469     maxBound = minBound - 1
 470 #endif
 471
 472 instance Real Word32 where
 473     toRational x = toInteger x % 1
 474
 475 instance Integral Word32 where
 476     div  x y           =  quotWord32 x y
 477     quot x y           =  quotWord32 x y
 478     rem  x y           =  remWord32 x y
 479     mod  x y           =  remWord32 x y
 480     quotRem a b        = (a `quotWord32` b, a `remWord32` b)
 481     divMod x y         = quotRem x y
 482     toInteger (W32# x) = word2Integer# x
 483     toInt     (W32# x) = I# (word2Int# x)
 484
 485 {-# INLINE quotWord32 #-}
 486 {-# INLINE remWord32  #-}
 487 (W32# x) `quotWord32` (W32# y) = W32# (x `quotWord#` y)
 488 (W32# x) `remWord32`  (W32# y) = W32# (x `remWord#`  y)
 489
 490 instance Ix Word32 where
 491     range (m,n)          = [m..n]
 492     index b@(m,n) i
 493            | inRange b i = word32ToInt (i - m)
 494            | otherwise   = error (showString "Ix{Word32}.index: Index " .
 495                                   showParen True (showsPrec 0 i) .
 496                                   showString " out of range " $
 497                                   showParen True (showsPrec 0 b) "")
 498     inRange (m,n) i      = m <= i && i <= n
 499
 500 instance Enum Word32 where
 501     toEnum        = intToWord32
 502     fromEnum      = word32ToInt
 503     enumFrom c       = map toEnum [fromEnum c .. fromEnum (maxBound::Word32)]
 504     enumFromThen c d = map toEnum [fromEnum c, fromEnum d .. fromEnum (last::Word32)]
 505                        where last = if d < c then minBound else maxBound
 506
 507 instance Read Word32 where
 508     readsPrec p = readDec
 509
 510 instance Show Word32 where
 511     showsPrec p = showInt
 512
 513 instance Bits Word32 where
 514   (W32# x)  .&.  (W32# y)  = W32# (x `and#` y)
 515   (W32# x)  .|.  (W32# y)  = W32# (x `or#` y)
 516   (W32# x) `xor` (W32# y)  = W32# (x `xor#` y)
 517   complement (W32# x)      = W32# (x `xor#` mb#) where (W32# mb#) = maxBound
 518   shift (W32# x) i@(I# i#)
 519         | i > 0     = W32# (wordToWord32# (shiftL# x i#))
 520         | otherwise = W32# (shiftRL# x (negateInt# i#))
 521   w@(W32# x)  `rotate` (I# i)
 522         | i ==# 0#    = w
 523         | i ># 0#     = W32# ((wordToWord32# (shiftL# x i')) `or#`
 524                               (shiftRL# (x `and#`
 525                                         (int2Word# (word2Int# maxBound# -# pow2# i2 +# 1#)))
 526                                      i2))
 527         | otherwise = rotate w (I# (32# +# i))
 528           where
 529            i' = word2Int# (int2Word# i `and#` int2Word# 31#)
 530            i2 = 32# -# i'
 531            (W32# maxBound#) = maxBound
 532
 533   bit (I# i#)
 534         | i# >=# 0# && i# <=# 31# = W32# (shiftL# (int2Word# 1#) i#)
 535         | otherwise = 0 -- We'll be overbearing, for now..
 536
 537   setBit x i        = x .|. bit i
 538   clearBit x i      = x .&. complement (bit i)
 539   complementBit x i = x `xor` bit i
 540
 541   testBit (W32# x#) (I# i#)
 542     | i# <# 32# && i# >=# 0# = (word2Int# (x# `and#` (shiftL# (int2Word# 1#) i#))) /=# 0#
 543     | otherwise             = False -- for now, this is really an error.
 544   bitSize  _        = 32
 545   isSigned _        = False
 546
 547 sizeofWord32 :: Word32
 548 sizeofWord32 = 4
 549 \end{code}
 550
 551 \subsection[Word64]{The @Word64@ interface}
 552
 553 \begin{code}
 554 #if WORD_SIZE_IN_BYTES == 8
 555 data Word64 = W64# Word#
 556
 557 word32ToWord64 :: Word32 -> Word64
 558 word32ToWord64 (W32 w#) = W64# w#
 559
 560 wordToWord32# :: Word# -> Word#
 561 wordToWord32# w# = w# `and#` (case (maxBound::Word32) of W# x# -> x#)
 562
 563 word64ToWord32 :: Word64 -> Word32
 564 word64ToWord32 (W64# w#) = W32# (wordToWord32# w#)
 565
 566 instance Eq  Word64     where
 567   (W64# x) == (W64# y) = x `eqWord#` y
 568   (W64# x) /= (W64# y) = x `neWord#` y
 569
 570 instance Ord Word64     where
 571   compare (W64# x#) (W64# y#) = compareWord# x# y#
 572   (<)  (W64# x) (W64# y)      = x `ltWord#` y
 573   (<=) (W64# x) (W64# y)      = x `leWord#` y
 574   (>=) (W64# x) (W64# y)      = x `geWord#` y
 575   (>)  (W64# x) (W64# y)      = x `gtWord#` y
 576   max x@(W64# x#) y@(W64# y#) =
 577      case (compareWord# x# y#) of { LT -> y ; EQ -> x ; GT -> x }
 578   min x@(W64# x#) y@(W64# y#) =
 579      case (compareWord# x# y#) of { LT -> x ; EQ -> x ; GT -> y }
 580
 581 instance Num Word64 where
 582   (W64# x) + (W64# y) =
 583       W64# (intToWord64# (word2Int# x +# word2Int# y))
 584   (W64# x) - (W64# y) =
 585       W64# (intToWord64# (word2Int# x -# word2Int# y))
 586   (W64# x) * (W64# y) =
 587       W64# (intToWord64# (word2Int# x *# word2Int# y))
 588   negate w@(W64# x)  =
 589      if x' ==# 0#
 590       then w
 591       else W64# (int2Word# (0x100# -# x'))
 592      where
 593       x' = word2Int# x
 594   abs x         = x
 595   signum        = signumReal
 596   fromInteger (J# a# s# d#) = W64# (integer2Word# a# s# d#)
 597   fromInt       = intToWord64
 598
 599 instance Bounded Word64 where
 600   minBound = 0
 601   maxBound = minBound - 1
 602
 603 instance Real Word64 where
 604   toRational x = toInteger x % 1
 605
 606 -- Note: no need to mask results here
 607 -- as they cannot overflow.
 608 instance Integral Word64 where
 609   div  (W64# x)  (W64# y)   = W64# (x `quotWord#` y)
 610   quot (W64# x)  (W64# y)   = W64# (x `quotWord#` y)
 611   rem  (W64# x)  (W64# y)   = W64# (x `remWord#` y)
 612   mod  (W64# x)  (W64# y)   = W64# (x `remWord#` y)
 613   quotRem (W64# x) (W64# y) = (W64# (x `quotWord#` y), W64# (x `remWord#` y))
 614   divMod  (W64# x) (W64# y) = (W64# (x `quotWord#` y), W64# (x `remWord#` y))
 615   toInteger (W64# x)        = word2Integer# x
 616   toInt x                   = word8ToInt x
 617
 618 instance Ix Word64 where
 619     range (m,n)          = [m..n]
 620     index b@(m,n) i
 621            | inRange b i = word64ToInt (i-m)
 622            | otherwise   = error (showString "Ix{Word64}.index: Index " .
 623                                   showParen True (showsPrec 0 i) .
 624                                   showString " out of range " $
 625                                   showParen True (showsPrec 0 b) "")
 626     inRange (m,n) i      = m <= i && i <= n
 627
 628 instance Enum Word64 where
 629     toEnum    (I# i)   = W64# (intToWord# i)
 630     fromEnum  (W64# w) = I# (word2Int# w)
 631     enumFrom c       = map toEnum [fromEnum c .. fromEnum (maxBound::Word64)] -- a long list!
 632     enumFromThen c d = map toEnum [fromEnum c, fromEnum d .. fromEnum (last::Word64)]
 633                        where last = if d < c then minBound else maxBound
 634
 635 instance Read Word64 where
 636     readsPrec p = readDec
 637
 638 instance Show Word64 where
 639     showsPrec p = showInt
 640
 641
 642 instance Bits Word64 where
 643   (W64# x)  .&.  (W64# y)    = W64# (x `and#` y)
 644   (W64# x)  .|.  (W64# y)    = W64# (x `or#` y)
 645   (W64# x) `xor` (W64# y)    = W64# (x `xor#` y)
 646   complement (W64# x)        = W64# (x `xor#` (case (maxBound::Word64) of W64# x# -> x#))
 647   shift (W64# x#) i@(I# i#)
 648         | i > 0     = W64# (shiftL# x# i#)
 649         | otherwise = W64# (shiftRL# x# (negateInt# i#))
 650
 651   w@(W64# x)  `rotate` (I# i)
 652         | i ==# 0#    = w
 653         | i ># 0#     = W64# (shiftL# x i') `or#`
 654                               (shiftRL# (x `and#`
 655                                         (int2Word# (word2Int# maxBound# -# pow2# i2 +# 1#)))
 656                                      i2))
 657         | otherwise = rotate w (I# (64# +# i))
 658           where
 659            i' = word2Int# (int2Word# i `and#` int2Word# 63#)
 660            i2 = 64# -# i'
 661            (W64# maxBound#) = maxBound
 662
 663   bit (I# i#)
 664         | i# >=# 0# && i# <=# 63# = W64# (shiftL# (int2Word# 1#) i#)
 665         | otherwise = 0 -- We'll be overbearing, for now..
 666
 667   setBit x i    = x .|. bit i
 668   clearBit x i  = x .&. complement (bit i)
 669   complementBit x i = x `xor` bit i
 670
 671   testBit (W64# x#) (I# i#)
 672     | i# <# 64# && i# >=# 0# = (word2Int# (x# `and#` (shiftL# (int2Word# 1#) i#))) /=# 0#
 673     | otherwise              = False -- for now, this is really an error.
 674
 675   bitSize  _    = 64
 676   isSigned _    = False
 677
 678 #else
 679 data Word64 = W64 {lo,hi::Word32} deriving (Eq, Ord, Bounded)
 680
 681 -- for completeness sake
 682 word32ToWord64 :: Word32 -> Word64
 683 word32ToWord64 w = W64 w 0
 684
 685 word64ToWord32 :: Word64 -> Word32
 686 word64ToWord32 (W64 lo _) = lo
 687
 688 word64ToInteger :: Word64 -> Integer
 689 word64ToInteger W64{lo,hi} = toInteger lo + 0x100000000 * toInteger hi
 690
 691 integerToWord64 :: Integer -> Word64
 692 integerToWord64 x = case x `quotRem` 0x100000000 of
 693                       (h,l) -> W64{lo=fromInteger l, hi=fromInteger h}
 694
 695 instance Show Word64 where
 696   showsPrec p x = showsPrec p (word64ToInteger x)
 697
 698 instance Read Word64 where
 699   readsPrec p s = [ (integerToWord64 x,r) | (x,r) <- readDec s ]
 700
 701 #endif
 702
 703 sizeofWord64 :: Word32
 704 sizeofWord64 = 8
 705 \end{code}
 706
 707
 708
 709 The Hugs-GHC extension libraries provide functions for going between
 710 Int and the various (un)signed ints. Here we provide the same for
 711 the GHC specific Word type:
 712
 713 \begin{code}
 714 wordToWord8  :: Word -> Word8
 715 word8ToWord  :: Word8 -> Word
 716 wordToWord16 :: Word -> Word16
 717 word16ToWord :: Word16 -> Word
 718 wordToWord32 :: Word -> Word32
 719 word32ToWord :: Word32 -> Word
 720
 721 word8ToWord (W8# w#)   = W# w#
 722 wordToWord8 (W# w#)    = W8# (w# `and#` (case (maxBound::Word8) of W8# x# -> x#))
 723 word16ToWord (W16# w#) = W# w#
 724 wordToWord16 (W# w#)   = W16# (w# `and#` (case (maxBound::Word16) of W16# x# -> x#))
 725 word32ToWord (W32# w#) = W# w#
 726 wordToWord32 (W# w#)   = W32# (w# `and#` (case (maxBound::Word32) of W32# x# -> x#))
 727
 728 \end{code}
 729
 730
 731 --End of exported definitions
 732
 733 The remainder of this file consists of definitions which are only
 734 used in the implementation.
 735
 736 \begin{code}
 737 signumReal x | x == 0    =  0
 738              | x > 0     =  1
 739              | otherwise = -1
 740
 741 \end{code}
 742
 743
 744 NOTE: the index is in units of the size of the type, *not* bytes.
 745
 746 \begin{code}
 747 indexWord8OffAddr  :: Addr -> Int -> Word8
 748 indexWord8OffAddr (A# a#) (I# i#) = intToWord8 (I# (ord# (indexCharOffAddr# a# i#)))
 749
 750 indexWord16OffAddr :: Addr -> Int -> Word16
 751 indexWord16OffAddr a i =
 752 #ifdef WORDS_BIGENDIAN
 753   intToWord16 ( word8ToInt l + (word8ToInt maxBound) * word8ToInt h)
 754 #else
 755   intToWord16 ( word8ToInt h + (word8ToInt maxBound) * word8ToInt l)
 756 #endif
 757  where
 758    byte_idx = i * 2
 759    l = indexWord8OffAddr a byte_idx
 760    h = indexWord8OffAddr a (byte_idx+1)
 761
 762 indexWord32OffAddr :: Addr -> Int -> Word32
 763 indexWord32OffAddr (A# a#) i = wordToWord32 (W# (indexWordOffAddr# a# i'#))
 764  where
 765    -- adjust index to be in Word units, not Word32 ones.
 766   (I# i'#)
 767 #if WORD_SIZE_IN_BYTES==8
 768    = i `div` 2
 769 #else
 770    = i
 771 #endif
 772
 773 indexWord64OffAddr :: Addr -> Int -> Word64
 774 indexWord64OffAddr (A# i#)
 775 #if WORD_SIZE_IN_BYTES==8
 776  = W64# (indexWordOffAddr# a# i#)
 777 #else
 778  = error "Word.indexWord64OffAddr: not implemented yet"
 779 #endif
 780
 781 \end{code}
 782
 783 Read words out of mutable memory:
 784
 785 \begin{code}
 786 readWord8OffAddr :: Addr -> Int -> IO Word8
 787 readWord8OffAddr a i = _casm_ `` %r=(StgWord8)(((StgWord8*)%0)[(StgInt)%1]); '' a i
 788
 789 readWord16OffAddr  :: Addr -> Int -> IO Word16
 790 readWord16OffAddr a i = _casm_ `` %r=(StgWord16)(((StgWord16*)%0)[(StgInt)%1]); '' a i
 791
 792 readWord32OffAddr  :: Addr -> Int -> IO Word32
 793 readWord32OffAddr a i = _casm_ `` %r=(StgWord32)(((StgWord32*)%0)[(StgInt)%1]); '' a i
 794
 795 readWord64OffAddr  :: Addr -> Int -> IO Word64
 796 #if WORD_SIZE_IN_BYTES==8
 797 readWord64OffAddr a i = _casm_ `` %r=(StgWord)(((StgWord*)%0)[(StgInt)%1]); '' a i
 798 #else
 799 readWord64OffAddr a i = error "Word.readWord64OffAddr: not implemented yet"
 800 #endif
 801 \end{code}
 802
 803 \begin{code}
 804 writeWord8OffAddr  :: Addr -> Int -> Word8  -> IO ()
 805 writeWord8OffAddr a i e = _casm_ `` (((StgWord8*)%0)[(StgInt)%1])=(StgWord8)%2; '' a i e
 806
 807 writeWord16OffAddr :: Addr -> Int -> Word16 -> IO ()
 808 writeWord16OffAddr a i e = _casm_ `` (((StgWord16*)%0)[(StgInt)%1])=(StgWord16)%2; '' a i e
 809
 810 writeWord32OffAddr :: Addr -> Int -> Word32 -> IO ()
 811 writeWord32OffAddr a i e = _casm_ `` (((StgWord32*)%0)[(StgInt)%1])=(StgWord32)%2; '' a i e
 812
 813 writeWord64OffAddr :: Addr -> Int -> Word64 -> IO ()
 814 #if WORD_SIZE_IN_BYTES==8
 815 writeWord64OffAddr a i e = _casm_ `` (((StgWord*)%0)[(StgInt)%1])=(StgWord)%2; '' a i e
 816 #else
 817 writeWord64OffAddr = error "Word.writeWord64OffAddr: not implemented yet"
 818 #endif
 819
 820 \end{code}