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         , wordToWord64    -- :: Word   -> Word64
  48         , word64ToWord    -- :: Word64 -> Word
  49
  50         -- The "official" place to get these from is Addr.
  51         , indexWord8OffAddr
  52         , indexWord16OffAddr
  53         , indexWord32OffAddr
  54         , indexWord64OffAddr
  55
  56         , readWord8OffAddr
  57         , readWord16OffAddr
  58         , readWord32OffAddr
  59         , readWord64OffAddr
  60
  61         , writeWord8OffAddr
  62         , writeWord16OffAddr
  63         , writeWord32OffAddr
  64         , writeWord64OffAddr
  65
  66         , sizeofWord8
  67         , sizeofWord16
  68         , sizeofWord32
  69         , sizeofWord64
  70
  71         -- The "official" place to get these from is Foreign
  72 #ifndef __PARALLEL_HASKELL__
  73         , indexWord8OffForeignObj
  74         , indexWord16OffForeignObj
  75         , indexWord32OffForeignObj
  76         , indexWord64OffForeignObj
  77
  78         , readWord8OffForeignObj
  79         , readWord16OffForeignObj
  80         , readWord32OffForeignObj
  81         , readWord64OffForeignObj
  82
  83         , writeWord8OffForeignObj
  84         , writeWord16OffForeignObj
  85         , writeWord32OffForeignObj
  86         , writeWord64OffForeignObj
  87 #endif
  88
  89         -- non-standard, GHC specific
  90         , wordToInt
  91
  92         ) where
  93
  94 #ifdef __HUGS__
  95 import PreludeBuiltin
  96 #else
  97 import GlaExts
  98 import CCall
  99 import PrelForeign
 100 import PrelIOBase
 101 import PrelAddr
 102 #endif
 103 import Ix
 104 import Bits
 105 import Numeric (readDec, showInt)
 106
 107 -----------------------------------------------------------------------------
 108 -- The "official" coercion functions
 109 -----------------------------------------------------------------------------
 110
 111 word8ToWord32  :: Word8  -> Word32
 112 word32ToWord8  :: Word32 -> Word8
 113 word16ToWord32 :: Word16 -> Word32
 114 word32ToWord16 :: Word32 -> Word16
 115
 116 word8ToInt   :: Word8  -> Int
 117 intToWord8   :: Int    -> Word8
 118 word16ToInt  :: Word16 -> Int
 119 intToWord16  :: Int    -> Word16
 120
 121 word8ToInt  = word32ToInt    . word8ToWord32
 122 intToWord8  = word32ToWord8  . intToWord32
 123 word16ToInt = word32ToInt    . word16ToWord32
 124 intToWord16 = word32ToWord16 . intToWord32
 125
 126 intToWord32 (I# x)   = W32# ((int2Word# x) `and#` (case (maxBound::Word32) of W32# x# -> x#))
 127 --intToWord32 (I# x)   = W32# (int2Word# x)
 128 word32ToInt (W32# x) = I#   (word2Int# x)
 129
 130 wordToInt :: Word -> Int
 131 wordToInt (W# w#) = I# (word2Int# w#)
 132
 133 \end{code}
 134
 135 \subsection[Word8]{The @Word8@ interface}
 136
 137 The byte type @Word8@ is represented in the Haskell
 138 heap by boxing up a 32-bit quantity, @Word#@. An invariant
 139 for this representation is that the higher 24 bits are
 140 *always* zeroed out. A consequence of this is that
 141 operations that could possibly overflow have to mask
 142 out the top three bytes before building the resulting @Word8@.
 143
 144 \begin{code}
 145 data Word8  = W8# Word#
 146
 147 instance CCallable Word8
 148 instance CReturnable Word8
 149
 150 word8ToWord32 (W8#  x) = W32# x
 151 word32ToWord8 (W32# x) = W8# (wordToWord8# x)
 152
 153 -- mask out upper three bytes.
 154 intToWord8# :: Int# -> Word#
 155 intToWord8# i# = (int2Word# i#) `and#` (int2Word# 0xff#)
 156
 157 wordToWord8# :: Word# -> Word#
 158 wordToWord8# w# = w# `and#` (int2Word# 0xff#)
 159
 160 instance Eq  Word8     where
 161   (W8# x) == (W8# y) = x `eqWord#` y
 162   (W8# x) /= (W8# y) = x `neWord#` y
 163
 164 instance Ord Word8     where
 165   compare (W8# x#) (W8# y#) = compareWord# x# y#
 166   (<)  (W8# x) (W8# y)      = x `ltWord#` y
 167   (<=) (W8# x) (W8# y)      = x `leWord#` y
 168   (>=) (W8# x) (W8# y)      = x `geWord#` y
 169   (>)  (W8# x) (W8# y)      = x `gtWord#` y
 170   max x@(W8# x#) y@(W8# y#) =
 171      case (compareWord# x# y#) of { LT -> y ; EQ -> x ; GT -> x }
 172   min x@(W8# x#) y@(W8# y#) =
 173      case (compareWord# x# y#) of { LT -> x ; EQ -> x ; GT -> y }
 174
 175 -- Helper function, used by Ord Word* instances.
 176 compareWord# :: Word# -> Word# -> Ordering
 177 compareWord# x# y#
 178  | x# `ltWord#` y# = LT
 179  | x# `eqWord#` y# = EQ
 180  | otherwise       = GT
 181
 182 instance Num Word8 where
 183   (W8# x) + (W8# y) =
 184       W8# (intToWord8# (word2Int# x +# word2Int# y))
 185   (W8# x) - (W8# y) =
 186       W8# (intToWord8# (word2Int# x -# word2Int# y))
 187   (W8# x) * (W8# y) =
 188       W8# (intToWord8# (word2Int# x *# word2Int# y))
 189   negate w@(W8# x)  =
 190      if x' ==# 0#
 191       then w
 192       else W8# (int2Word# (0x100# -# x'))
 193      where
 194       x' = word2Int# x
 195   abs x         = x
 196   signum        = signumReal
 197   fromInteger (J# a# s# d#) = W8# (wordToWord8# (integer2Word# a# s# d#))
 198   fromInt       = intToWord8
 199
 200 instance Bounded Word8 where
 201   minBound = 0
 202   maxBound = 0xff
 203
 204 instance Real Word8 where
 205   toRational x = toInteger x % 1
 206
 207 -- Note: no need to mask results here
 208 -- as they cannot overflow.
 209 instance Integral Word8 where
 210   div  (W8# x)  (W8# y)   = W8# (x `quotWord#` y)
 211   quot (W8# x)  (W8# y)   = W8# (x `quotWord#` y)
 212   rem  (W8# x)  (W8# y)   = W8# (x `remWord#` y)
 213   mod  (W8# x)  (W8# y)   = W8# (x `remWord#` y)
 214   quotRem (W8# x) (W8# y) = (W8# (x `quotWord#` y), W8# (x `remWord#` y))
 215   divMod  (W8# x) (W8# y) = (W8# (x `quotWord#` y), W8# (x `remWord#` y))
 216   toInteger (W8# x)       = word2Integer x
 217   toInt x                 = word8ToInt x
 218
 219 instance Ix Word8 where
 220     range (m,n)          = [m..n]
 221     index b@(m,n) i
 222            | inRange b i = word8ToInt (i-m)
 223            | otherwise   = error (showString "Ix{Word8}.index: Index " .
 224                                   showParen True (showsPrec 0 i) .
 225                                   showString " out of range " $
 226                                   showParen True (showsPrec 0 b) "")
 227     inRange (m,n) i      = m <= i && i <= n
 228
 229 instance Enum Word8 where
 230     toEnum    (I# i)  = W8# (intToWord8# i)
 231     fromEnum  (W8# w) = I# (word2Int# w)
 232     enumFrom c       = map toEnum [fromEnum c .. fromEnum (maxBound::Word8)]
 233     enumFromThen c d = map toEnum [fromEnum c, fromEnum d .. fromEnum (last::Word8)]
 234                        where last = if d < c then minBound else maxBound
 235
 236 instance Read Word8 where
 237     readsPrec p = readDec
 238
 239 instance Show Word8 where
 240     showsPrec p = showInt
 241
 242 --
 243 -- Word8s are represented by an (unboxed) 32-bit Word.
 244 -- The invariant is that the upper 24 bits are always zeroed out.
 245 --
 246 instance Bits Word8 where
 247   (W8# x)  .&.  (W8# y)    = W8# (x `and#` y)
 248   (W8# x)  .|.  (W8# y)    = W8# (x `or#` y)
 249   (W8# x) `xor` (W8# y)    = W8# (x `xor#` y)
 250   complement (W8# x)       = W8# (x `xor#` int2Word# 0xff#)
 251   shift (W8# x#) i@(I# i#)
 252         | i > 0     = W8# (wordToWord8# (shiftL# x# i#))
 253         | otherwise = W8# (wordToWord8# (shiftRL# x# (negateInt# i#)))
 254   w@(W8# x)  `rotate` (I# i)
 255         | i ==# 0#    = w
 256         | i ># 0#     = W8# ((wordToWord8# (shiftL# x i')) `or#`
 257                              (shiftRL# (x `and#`
 258                                         (int2Word# (0x100# -# pow2# i2)))
 259                                        i2))
 260         | otherwise = rotate w (I# (8# +# i))
 261           where
 262            i' = word2Int# (int2Word# i `and#` int2Word# 7#)
 263            i2 = 8# -# i'
 264
 265   bit (I# i#)
 266         | i# >=# 0# && i# <=# 7# = W8# (wordToWord8# (shiftL# (int2Word# 1#) i#))
 267         | otherwise = 0 -- We'll be overbearing, for now..
 268
 269   setBit x i    = x .|. bit i
 270   clearBit x i  = x .&. complement (bit i)
 271   complementBit x i = x `xor` bit i
 272
 273   testBit (W8# x#) (I# i#)
 274     | i# <# 8# && i# >=# 0# = (word2Int# (x# `and#` (shiftL# (int2Word# 1#) i#))) /=# 0#
 275     | otherwise             = False -- for now, this is really an error.
 276
 277   bitSize  _    = 8
 278   isSigned _    = False
 279
 280 pow2# :: Int# -> Int#
 281 pow2# x# = word2Int# (shiftL# (int2Word# 1#) x#)
 282
 283 word2Integer w = case word2Integer# w of
 284                         (# a, s, d #) -> J# a s d
 285
 286 pow2_64# :: Int# -> Int64#
 287 pow2_64# x# = word64ToInt64# (shiftL64# (wordToWord64# (int2Word# 1#)) x#)
 288
 289 sizeofWord8 :: Word32
 290 sizeofWord8 = 1
 291
 292 \end{code}
 293
 294 \subsection[Word16]{The @Word16@ interface}
 295
 296 The double byte type @Word16@ is represented in the Haskell
 297 heap by boxing up a machine word, @Word#@. An invariant
 298 for this representation is that only the lower 16 bits are
 299 `active', any bits above are {\em always} zeroed out.
 300 A consequence of this is that operations that could possibly
 301 overflow have to mask out anything above the lower two bytes
 302 before putting together the resulting @Word16@.
 303
 304 \begin{code}
 305 data Word16 = W16# Word#
 306 instance CCallable Word16
 307 instance CReturnable Word16
 308
 309 word16ToWord32 (W16# x) = W32# x
 310 word32ToWord16 (W32# x) = W16# (wordToWord16# x)
 311
 312 -- mask out upper 16 bits.
 313 intToWord16# :: Int# -> Word#
 314 intToWord16# i# = ((int2Word# i#) `and#` (int2Word# 0xffff#))
 315
 316 wordToWord16# :: Word# -> Word#
 317 wordToWord16# w# = w# `and#` (int2Word# 0xffff#)
 318
 319 instance Eq  Word16    where
 320   (W16# x) == (W16# y) = x `eqWord#` y
 321   (W16# x) /= (W16# y) = x `neWord#` y
 322
 323 instance Ord Word16     where
 324   compare (W16# x#) (W16# y#) = compareWord# x# y#
 325   (<)  (W16# x) (W16# y)      = x `ltWord#` y
 326   (<=) (W16# x) (W16# y)      = x `leWord#` y
 327   (>=) (W16# x) (W16# y)      = x `geWord#` y
 328   (>)  (W16# x) (W16# y)      = x `gtWord#` y
 329   max x@(W16# x#) y@(W16# y#) =
 330      case (compareWord# x# y#) of { LT -> y ; EQ -> x ; GT -> x }
 331   min x@(W16# x#) y@(W16# y#) =
 332      case (compareWord# x# y#) of { LT -> x ; EQ -> x ; GT -> y }
 333
 334 instance Num Word16 where
 335   (W16# x) + (W16# y) =
 336        W16# (intToWord16# (word2Int# x +# word2Int# y))
 337   (W16# x) - (W16# y) =
 338        W16# (intToWord16# (word2Int# x -# word2Int# y))
 339   (W16# x) * (W16# y) =
 340        W16# (intToWord16# (word2Int# x *# word2Int# y))
 341   negate w@(W16# x)  =
 342        if x' ==# 0#
 343         then w
 344         else W16# (int2Word# (0x10000# -# x'))
 345        where
 346         x' = word2Int# x
 347   abs x         = x
 348   signum        = signumReal
 349   fromInteger (J# a# s# d#) = W16# (wordToWord16# (integer2Word# a# s# d#))
 350   fromInt       = intToWord16
 351
 352 instance Bounded Word16 where
 353   minBound = 0
 354   maxBound = 0xffff
 355
 356 instance Real Word16 where
 357   toRational x = toInteger x % 1
 358
 359 instance Integral Word16 where
 360   div  (W16# x)  (W16# y)   = W16# (x `quotWord#` y)
 361   quot (W16# x)  (W16# y)   = W16# (x `quotWord#` y)
 362   rem  (W16# x)  (W16# y)   = W16# (x `remWord#` y)
 363   mod  (W16# x)  (W16# y)   = W16# (x `remWord#` y)
 364   quotRem (W16# x) (W16# y) = (W16# (x `quotWord#` y), W16# (x `remWord#` y))
 365   divMod  (W16# x) (W16# y) = (W16# (x `quotWord#` y), W16# (x `remWord#` y))
 366   toInteger (W16# x)        = word2Integer x
 367   toInt x                   = word16ToInt x
 368
 369 instance Ix Word16 where
 370   range (m,n)          = [m..n]
 371   index b@(m,n) i
 372          | inRange b i = word16ToInt (i - m)
 373          | otherwise   = error (showString "Ix{Word16}.index: Index " .
 374                                 showParen True (showsPrec 0 i) .
 375                                 showString " out of range " $
 376                                 showParen True (showsPrec 0 b) "")
 377   inRange (m,n) i      = m <= i && i <= n
 378
 379 instance Enum Word16 where
 380   toEnum    (I# i)   = W16# (intToWord16# i)
 381   fromEnum  (W16# w) = I# (word2Int# w)
 382   enumFrom c       = map toEnum [fromEnum c .. fromEnum (maxBound::Word16)]
 383   enumFromThen c d = map toEnum [fromEnum c, fromEnum d .. fromEnum (last::Word16)]
 384                        where last = if d < c then minBound else maxBound
 385
 386 instance Read Word16 where
 387   readsPrec p = readDec
 388
 389 instance Show Word16 where
 390   showsPrec p = showInt
 391
 392 instance Bits Word16 where
 393   (W16# x)  .&.  (W16# y)  = W16# (x `and#` y)
 394   (W16# x)  .|.  (W16# y)  = W16# (x `or#` y)
 395   (W16# x) `xor` (W16# y)  = W16# (x `xor#` y)
 396   complement (W16# x)      = W16# (x `xor#` int2Word# 0xffff#)
 397   shift (W16# x#) i@(I# i#)
 398         | i > 0     = W16# (wordToWord16# (shiftL# x# i#))
 399         | otherwise = W16# (shiftRL# x# (negateInt# i#))
 400   w@(W16# x)  `rotate` (I# i)
 401         | i ==# 0#    = w
 402         | i ># 0#     = W16# ((wordToWord16# (shiftL# x i')) `or#`
 403                               (shiftRL# (x `and#`
 404                                          (int2Word# (0x10000# -# pow2# i2)))
 405                                         i2))
 406         | otherwise = rotate w (I# (16# +# i'))
 407           where
 408            i' = word2Int# (int2Word# i `and#` int2Word# 15#)
 409            i2 = 16# -# i'
 410   bit (I# i#)
 411         | i# >=# 0# && i# <=# 15# = W16# (shiftL# (int2Word# 1#) i#)
 412         | otherwise = 0 -- We'll be overbearing, for now..
 413
 414   setBit x i    = x .|. bit i
 415   clearBit x i  = x .&. complement (bit i)
 416   complementBit x i = x `xor` bit i
 417
 418   testBit (W16# x#) (I# i#)
 419     | i# <# 16# && i# >=# 0# = (word2Int# (x# `and#` (shiftL# (int2Word# 1#) i#))) /=# 0#
 420     | otherwise             = False -- for now, this is really an error.
 421
 422   bitSize  _    = 16
 423   isSigned _    = False
 424
 425
 426 sizeofWord16 :: Word32
 427 sizeofWord16 = 2
 428
 429 \end{code}
 430
 431 \subsection[Word32]{The @Word32@ interface}
 432
 433 The quad byte type @Word32@ is represented in the Haskell
 434 heap by boxing up a machine word, @Word#@. An invariant
 435 for this representation is that any bits above the lower
 436 32 are {\em always} zeroed out. A consequence of this is that
 437 operations that could possibly overflow have to mask
 438 the result before building the resulting @Word16@.
 439
 440 \begin{code}
 441 data Word32 = W32# Word#
 442
 443 instance CCallable Word32
 444 instance CReturnable Word32
 445
 446 instance Eq  Word32    where
 447   (W32# x) == (W32# y) = x `eqWord#` y
 448   (W32# x) /= (W32# y) = x `neWord#` y
 449
 450 instance Ord Word32    where
 451   compare (W32# x#) (W32# y#) = compareWord# x# y#
 452   (<)  (W32# x) (W32# y)      = x `ltWord#` y
 453   (<=) (W32# x) (W32# y)      = x `leWord#` y
 454   (>=) (W32# x) (W32# y)      = x `geWord#` y
 455   (>)  (W32# x) (W32# y)      = x `gtWord#` y
 456   max x@(W32# x#) y@(W32# y#) =
 457      case (compareWord# x# y#) of { LT -> y ; EQ -> x ; GT -> x }
 458   min x@(W32# x#) y@(W32# y#) =
 459      case (compareWord# x# y#) of { LT -> x ; EQ -> x ; GT -> y }
 460
 461 instance Num Word32 where
 462   (W32# x) + (W32# y) =
 463        W32# (intToWord32# (word2Int# x +# word2Int# y))
 464   (W32# x) - (W32# y) =
 465        W32# (intToWord32# (word2Int# x -# word2Int# y))
 466   (W32# x) * (W32# y) =
 467        W32# (intToWord32# (word2Int# x *# word2Int# y))
 468 #if WORD_SIZE_IN_BYTES == 8
 469   negate w@(W32# x)  =
 470       if x' ==# 0#
 471        then w
 472        else W32# (intToWord32# (0x100000000# -# x'))
 473        where
 474         x' = word2Int# x
 475 #else
 476   negate (W32# x)  = W32# (intToWord32# (negateInt# (word2Int# x)))
 477 #endif
 478   abs x           = x
 479   signum          = signumReal
 480   fromInteger (J# a# s# d#) = W32# (integer2Word# a# s# d#)
 481   fromInt (I# x)  = W32# (intToWord32# x)
 482     -- ToDo: restrict fromInt{eger} range.
 483
 484 intToWord32#  :: Int#  -> Word#
 485 wordToWord32# :: Word# -> Word#
 486
 487 #if WORD_SIZE_IN_BYTES == 8
 488 intToWord32#  i# = (int2Word# i#) `and#` (int2Word# 0xffffffff)
 489 wordToWord32# w# = w# `and#` (int2Word# 0xffffffff)
 490 wordToWord64# w# = w#
 491 #else
 492 intToWord32#  i# = int2Word# i#
 493 wordToWord32# w# = w#
 494
 495 #endif
 496
 497 instance Bounded Word32 where
 498     minBound = 0
 499 #if WORD_SIZE_IN_BYTES == 8
 500     maxBound = 0xffffffff
 501 #else
 502     maxBound = minBound - 1
 503 #endif
 504
 505 instance Real Word32 where
 506     toRational x = toInteger x % 1
 507
 508 instance Integral Word32 where
 509     div  x y           =  quotWord32 x y
 510     quot x y           =  quotWord32 x y
 511     rem  x y           =  remWord32 x y
 512     mod  x y           =  remWord32 x y
 513     quotRem a b        = (a `quotWord32` b, a `remWord32` b)
 514     divMod x y         = quotRem x y
 515     toInteger (W32# x) = word2Integer x
 516     toInt     (W32# x) = I# (word2Int# x)
 517
 518 {-# INLINE quotWord32 #-}
 519 {-# INLINE remWord32  #-}
 520 (W32# x) `quotWord32` (W32# y) = W32# (x `quotWord#` y)
 521 (W32# x) `remWord32`  (W32# y) = W32# (x `remWord#`  y)
 522
 523 instance Ix Word32 where
 524     range (m,n)          = [m..n]
 525     index b@(m,n) i
 526            | inRange b i = word32ToInt (i - m)
 527            | otherwise   = error (showString "Ix{Word32}.index: Index " .
 528                                   showParen True (showsPrec 0 i) .
 529                                   showString " out of range " $
 530                                   showParen True (showsPrec 0 b) "")
 531     inRange (m,n) i      = m <= i && i <= n
 532
 533 instance Enum Word32 where
 534     toEnum                  = intToWord32
 535     fromEnum                = word32ToInt   -- lossy, don't use.
 536     enumFrom w              = [w .. maxBound]
 537     enumFromTo   w1 w2
 538        | w1 > w2   = []
 539        | otherwise = eft32 w1 w2
 540
 541     enumFromThen w1 w2   = [w1,w2 .. last]
 542        where
 543          last
 544           | w1 < w2   = maxBound::Word32
 545           | otherwise = minBound
 546
 547     enumFromThenTo w1 w2 wend  = eftt32 w1 stepWith
 548      where
 549        diff1 = w2 - w1
 550        diff2 = w1 - w2
 551
 552        increasing = w2 > w1
 553
 554        stepWith :: Word32 -> Maybe Word32
 555        stepWith x
 556          | increasing && x > nxt = Nothing --oflow.
 557          | wend <= x  = Nothing
 558          | otherwise  = Just nxt
 559         where
 560          nxt
 561           | increasing = x + diff1
 562           | otherwise  = x - diff2
 563
 564 eftt32 :: Word32 -> (Word32 -> Maybe Word32) -> [Word32]
 565 eftt32 now stepper = go now
 566   where
 567     go now =
 568      case stepper now of
 569        Nothing -> [now]
 570        Just v  -> now : go v
 571
 572 eft32 :: Word32 -> Word32 -> [Word32]
 573 eft32 now last = go now
 574   where
 575    go x
 576     | x == last = [x]
 577     | otherwise = x:go (x+1)
 578
 579 instance Read Word32 where
 580     readsPrec p = readDec
 581
 582 instance Show Word32 where
 583     showsPrec p = showInt
 584
 585 instance Bits Word32 where
 586   (W32# x)  .&.  (W32# y)  = W32# (x `and#` y)
 587   (W32# x)  .|.  (W32# y)  = W32# (x `or#` y)
 588   (W32# x) `xor` (W32# y)  = W32# (x `xor#` y)
 589   complement (W32# x)      = W32# (x `xor#` mb#) where (W32# mb#) = maxBound
 590   shift (W32# x) i@(I# i#)
 591         | i > 0     = W32# (wordToWord32# (shiftL# x i#))
 592         | otherwise = W32# (shiftRL# x (negateInt# i#))
 593   w@(W32# x)  `rotate` (I# i)
 594         | i ==# 0#    = w
 595         | i ># 0#     = W32# ((wordToWord32# (shiftL# x i')) `or#`
 596                               (shiftRL# (x `and#`
 597                                         (int2Word# (word2Int# maxBound# -# pow2# i2 +# 1#)))
 598                                      i2))
 599         | otherwise = rotate w (I# (32# +# i))
 600           where
 601            i' = word2Int# (int2Word# i `and#` int2Word# 31#)
 602            i2 = 32# -# i'
 603            (W32# maxBound#) = maxBound
 604
 605   bit (I# i#)
 606         | i# >=# 0# && i# <=# 31# = W32# (shiftL# (int2Word# 1#) i#)
 607         | otherwise = 0 -- We'll be overbearing, for now..
 608
 609   setBit x i        = x .|. bit i
 610   clearBit x i      = x .&. complement (bit i)
 611   complementBit x i = x `xor` bit i
 612
 613   testBit (W32# x#) (I# i#)
 614     | i# <# 32# && i# >=# 0# = (word2Int# (x# `and#` (shiftL# (int2Word# 1#) i#))) /=# 0#
 615     | otherwise             = False -- for now, this is really an error.
 616   bitSize  _        = 32
 617   isSigned _        = False
 618
 619 sizeofWord32 :: Word32
 620 sizeofWord32 = 4
 621 \end{code}
 622
 623 \subsection[Word64]{The @Word64@ interface}
 624
 625 \begin{code}
 626 #if WORD_SIZE_IN_BYTES == 8
 627 --data Word64 = W64# Word#
 628
 629 word32ToWord64 :: Word32 -> Word64
 630 word32ToWord64 (W32 w#) = W64# w#
 631
 632 wordToWord32# :: Word# -> Word#
 633 wordToWord32# w# = w# `and#` (case (maxBound::Word32) of W# x# -> x#)
 634
 635 word64ToWord32 :: Word64 -> Word32
 636 word64ToWord32 (W64# w#) = W32# (wordToWord32# w#)
 637
 638 wordToWord64# w# = w#
 639 word64ToWord# w# = w#
 640
 641 instance Eq  Word64     where
 642   (W64# x) == (W64# y) = x `eqWord#` y
 643   (W64# x) /= (W64# y) = x `neWord#` y
 644
 645 instance Ord Word64     where
 646   compare (W64# x#) (W64# y#) = compareWord# x# y#
 647   (<)  (W64# x) (W64# y)      = x `ltWord#` y
 648   (<=) (W64# x) (W64# y)      = x `leWord#` y
 649   (>=) (W64# x) (W64# y)      = x `geWord#` y
 650   (>)  (W64# x) (W64# y)      = x `gtWord#` y
 651   max x@(W64# x#) y@(W64# y#) =
 652      case (compareWord# x# y#) of { LT -> y ; EQ -> x ; GT -> x }
 653   min x@(W64# x#) y@(W64# y#) =
 654      case (compareWord# x# y#) of { LT -> x ; EQ -> x ; GT -> y }
 655
 656 instance Num Word64 where
 657   (W64# x) + (W64# y) =
 658       W64# (intToWord64# (word2Int# x +# word2Int# y))
 659   (W64# x) - (W64# y) =
 660       W64# (intToWord64# (word2Int# x -# word2Int# y))
 661   (W64# x) * (W64# y) =
 662       W64# (intToWord64# (word2Int# x *# word2Int# y))
 663   negate w@(W64# x)  =
 664      if x' ==# 0#
 665       then w
 666       else W64# (int2Word# (0x100# -# x'))
 667      where
 668       x' = word2Int# x
 669   abs x         = x
 670   signum        = signumReal
 671   fromInteger (J# a# s# d#) = W64# (integer2Word# a# s# d#)
 672   fromInt       = intToWord64
 673
 674 instance Bounded Word64 where
 675   minBound = 0
 676   maxBound = minBound - 1
 677
 678 instance Real Word64 where
 679   toRational x = toInteger x % 1
 680
 681 -- Note: no need to mask results here
 682 -- as they cannot overflow.
 683 instance Integral Word64 where
 684   div  (W64# x)  (W64# y)   = W64# (x `quotWord#` y)
 685   quot (W64# x)  (W64# y)   = W64# (x `quotWord#` y)
 686   rem  (W64# x)  (W64# y)   = W64# (x `remWord#` y)
 687   mod  (W64# x)  (W64# y)   = W64# (x `remWord#` y)
 688   quotRem (W64# x) (W64# y) = (W64# (x `quotWord#` y), W64# (x `remWord#` y))
 689   divMod  (W64# x) (W64# y) = (W64# (x `quotWord#` y), W64# (x `remWord#` y))
 690   toInteger (W64# x)        = word2Integer# x
 691   toInt x                   = word64ToInt x
 692
 693 instance Ix Word64 where
 694     range (m,n)          = [m..n]
 695     index b@(m,n) i
 696            | inRange b i = word64ToInt (i-m)
 697            | otherwise   = error (showString "Ix{Word64}.index: Index " .
 698                                   showParen True (showsPrec 0 i) .
 699                                   showString " out of range " $
 700                                   showParen True (showsPrec 0 b) "")
 701     inRange (m,n) i      = m <= i && i <= n
 702
 703 instance Enum Word64 where
 704     toEnum    (I# i)        = W64# (intToWord# i)
 705     fromEnum  (W64# w)      = I# (word2Int# w)    -- lossy, don't use.
 706     enumFrom w              = eft64 w 1
 707     enumFromTo   w1 w2      = eftt64 w1 1 (> w2)
 708     enumFromThen w1 w2      = eftt64 w1 (w2 - w1) (>last)
 709         where
 710          last
 711           | w1 < w2   = maxBound::Word64
 712           | otherwise = minBound
 713
 714 instance Read Word64 where
 715     readsPrec p = readDec
 716
 717 instance Show Word64 where
 718     showsPrec p = showInt
 719
 720
 721 instance Bits Word64 where
 722   (W64# x)  .&.  (W64# y)    = W64# (x `and#` y)
 723   (W64# x)  .|.  (W64# y)    = W64# (x `or#` y)
 724   (W64# x) `xor` (W64# y)    = W64# (x `xor#` y)
 725   complement (W64# x)        = W64# (x `xor#` (case (maxBound::Word64) of W64# x# -> x#))
 726   shift (W64# x#) i@(I# i#)
 727         | i > 0     = W64# (shiftL# x# i#)
 728         | otherwise = W64# (shiftRL# x# (negateInt# i#))
 729
 730   w@(W64# x)  `rotate` (I# i)
 731         | i ==# 0#    = w
 732         | i ># 0#     = W64# (shiftL# x i') `or#`
 733                               (shiftRL# (x `and#`
 734                                         (int2Word# (word2Int# maxBound# -# pow2# i2 +# 1#)))
 735                                      i2))
 736         | otherwise = rotate w (I# (64# +# i))
 737           where
 738            i' = word2Int# (int2Word# i `and#` int2Word# 63#)
 739            i2 = 64# -# i'
 740            (W64# maxBound#) = maxBound
 741
 742   bit (I# i#)
 743         | i# >=# 0# && i# <=# 63# = W64# (shiftL# (int2Word# 1#) i#)
 744         | otherwise = 0 -- We'll be overbearing, for now..
 745
 746   setBit x i    = x .|. bit i
 747   clearBit x i  = x .&. complement (bit i)
 748   complementBit x i = x `xor` bit i
 749
 750   testBit (W64# x#) (I# i#)
 751     | i# <# 64# && i# >=# 0# = (word2Int# (x# `and#` (shiftL# (int2Word# 1#) i#))) /=# 0#
 752     | otherwise              = False -- for now, this is really an error.
 753
 754   bitSize  _    = 64
 755   isSigned _    = False
 756
 757 #else
 758 --defined in PrelCCall: data Word64 = W64 Word64# deriving (Eq, Ord, Bounded)
 759
 760 -- for completeness sake
 761 word32ToWord64 :: Word32 -> Word64
 762 word32ToWord64 (W32# w#) = W64# (wordToWord64# w#)
 763
 764 word64ToWord32 :: Word64 -> Word32
 765 word64ToWord32 (W64# w#) = W32# (word64ToWord# w#)
 766
 767 word64ToInteger :: Word64 -> Integer
 768 word64ToInteger (W64# w#) =
 769   case word64ToInteger# w# of
 770     (# a#, s#, p# #) -> J# a# s# p#
 771
 772 word64ToInt :: Word64 -> Int
 773 word64ToInt w =
 774    case w `quotRem` 0x100000000 of
 775      (h,l) -> toInt (word64ToWord32 l)
 776
 777 intToWord64# :: Int# -> Word64#
 778 intToWord64# i# = wordToWord64# (int2Word# i#)
 779
 780 intToWord64 :: Int -> Word64
 781 intToWord64 (I# i#) = W64# (intToWord64# i#)
 782
 783 integerToWord64 :: Integer -> Word64
 784 integerToWord64 (J# a# s# d#) = W64# (integerToWord64# a# s# d#)
 785
 786 instance Show Word64 where
 787   showsPrec p x = showsPrec p (word64ToInteger x)
 788
 789 instance Read Word64 where
 790   readsPrec p s = [ (integerToWord64 x,r) | (x,r) <- readDec s ]
 791
 792 instance Eq  Word64     where
 793   (W64# x) == (W64# y) = x `eqWord64#` y
 794   (W64# x) /= (W64# y) = not (x `eqWord64#` y)
 795
 796 instance Ord Word64     where
 797   compare (W64# x#) (W64# y#) = compareWord64# x# y#
 798   (<)  (W64# x) (W64# y)      = x `ltWord64#` y
 799   (<=) (W64# x) (W64# y)      = x `leWord64#` y
 800   (>=) (W64# x) (W64# y)      = x `geWord64#` y
 801   (>)  (W64# x) (W64# y)      = x `gtWord64#` y
 802   max x@(W64# x#) y@(W64# y#) =
 803      case (compareWord64# x# y#) of { LT -> y ; EQ -> x ; GT -> x }
 804   min x@(W64# x#) y@(W64# y#) =
 805      case (compareWord64# x# y#) of { LT -> x ; EQ -> x ; GT -> y }
 806
 807 instance Num Word64 where
 808   (W64# x) + (W64# y) =
 809       W64# (int64ToWord64# (word64ToInt64# x `plusInt64#` word64ToInt64# y))
 810   (W64# x) - (W64# y) =
 811       W64# (int64ToWord64# (word64ToInt64# x `minusInt64#` word64ToInt64# y))
 812   (W64# x) * (W64# y) =
 813       W64# (int64ToWord64# (word64ToInt64# x `timesInt64#` word64ToInt64# y))
 814   negate w
 815      | w == 0     = w
 816      | otherwise  = maxBound - w
 817
 818   abs x         = x
 819   signum        = signumReal
 820   fromInteger i = integerToWord64 i
 821   fromInt       = intToWord64
 822
 823 instance Bounded Word64 where
 824   minBound = 0
 825   maxBound = minBound - 1
 826
 827 instance Real Word64 where
 828   toRational x = toInteger x % 1
 829
 830 -- Note: no need to mask results here
 831 -- as they cannot overflow.
 832 instance Integral Word64 where
 833   div  (W64# x)  (W64# y)   = W64# (x `quotWord64#` y)
 834   quot (W64# x)  (W64# y)   = W64# (x `quotWord64#` y)
 835   rem  (W64# x)  (W64# y)   = W64# (x `remWord64#` y)
 836   mod  (W64# x)  (W64# y)   = W64# (x `remWord64#` y)
 837   quotRem (W64# x) (W64# y) = (W64# (x `quotWord64#` y), W64# (x `remWord64#` y))
 838   divMod  (W64# x) (W64# y) = (W64# (x `quotWord64#` y), W64# (x `remWord64#` y))
 839   toInteger w64             = word64ToInteger w64
 840   toInt x                   = word64ToInt x
 841
 842
 843 instance Ix Word64 where
 844     range (m,n)          = [m..n]
 845     index b@(m,n) i
 846            | inRange b i = word64ToInt (i-m)
 847            | otherwise   = error (showString "Ix{Word64}.index: Index " .
 848                                   showParen True (showsPrec 0 i) .
 849                                   showString " out of range " $
 850                                   showParen True (showsPrec 0 b) "")
 851     inRange (m,n) i      = m <= i && i <= n
 852
 853 instance Enum Word64 where
 854     toEnum    (I# i)        = W64# (intToWord64# i)
 855     fromEnum  (W64# w)      = I# (word2Int# (word64ToWord# w))  -- lossy, don't use.
 856     enumFrom w              = eft64 w 1
 857     enumFromTo   w1 w2      = eftt64 w1 1 (> w2)
 858     enumFromThen w1 w2      = eftt64 w1 (w2 - w1) (>last)
 859         where
 860          last
 861           | w1 < w2   = maxBound::Word64
 862           | otherwise = minBound
 863
 864 instance Bits Word64 where
 865   (W64# x)  .&.  (W64# y)    = W64# (x `and64#` y)
 866   (W64# x)  .|.  (W64# y)    = W64# (x `or64#` y)
 867   (W64# x) `xor` (W64# y)    = W64# (x `xor64#` y)
 868   complement (W64# x)        = W64# (x `xor64#` (case (maxBound::Word64) of W64# x# -> x#))
 869   shift (W64# x#) i@(I# i#)
 870         | i > 0     = W64# (shiftL64# x# i#)
 871         | otherwise = W64# (shiftRL64# x# (negateInt# i#))
 872
 873   w@(W64# x)  `rotate` (I# i)
 874         | i ==# 0#    = w
 875         | i ># 0#     = W64# ((shiftL64# x i') `or64#`
 876                               (shiftRL64# (x `and64#`
 877                                            (int64ToWord64# ((word64ToInt64# maxBound#) `minusInt64#`
 878                                                            (pow2_64# i2 `plusInt64#` (intToInt64# 1#))))))
 879                                      i2)
 880         | otherwise = rotate w (I# (64# +# i))
 881           where
 882            i' = word2Int# (int2Word# i `and#` int2Word# 63#)
 883            i2 = 64# -# i'
 884            (W64# maxBound#) = maxBound
 885
 886   bit (I# i#)
 887         | i# >=# 0# && i# <=# 63# = W64# (shiftL64# (wordToWord64# (int2Word# 1#)) i#)
 888         | otherwise = 0 -- We'll be overbearing, for now..
 889
 890   setBit x i    = x .|. bit i
 891   clearBit x i  = x .&. complement (bit i)
 892   complementBit x i = x `xor` bit i
 893
 894   testBit (W64# x#) (I# i#)
 895     | i# <# 64# && i# >=# 0# = (word2Int# (word64ToWord# (x# `and64#` (shiftL64# (wordToWord64# (int2Word# 1#)) i#)))) /=# 0#
 896     | otherwise              = False -- for now, this is really an error.
 897
 898   bitSize  _    = 64
 899   isSigned _    = False
 900
 901 compareWord64# i# j#
 902  | i# `ltWord64#` j# = LT
 903  | i# `eqWord64#` j# = EQ
 904  | otherwise         = GT
 905
 906 -- Word64# primop wrappers:
 907
 908 ltWord64# :: Word64# -> Word64# -> Bool
 909 ltWord64# x# y# =  unsafePerformIO $ do
 910         v <- _ccall_ stg_ltWord64 x# y#
 911         case (v::Int) of
 912           0 -> return False
 913           _ -> return True
 914
 915 leWord64# :: Word64# -> Word64# -> Bool
 916 leWord64# x# y# =  unsafePerformIO $ do
 917         v <- _ccall_ stg_leWord64 x# y#
 918         case (v::Int) of
 919           0 -> return False
 920           _ -> return True
 921
 922 eqWord64# :: Word64# -> Word64# -> Bool
 923 eqWord64# x# y# =  unsafePerformIO $ do
 924         v <- _ccall_ stg_eqWord64 x# y#
 925         case (v::Int) of
 926           0 -> return False
 927           _ -> return True
 928
 929 neWord64# :: Word64# -> Word64# -> Bool
 930 neWord64# x# y# =  unsafePerformIO $ do
 931         v <- _ccall_ stg_neWord64 x# y#
 932         case (v::Int) of
 933           0 -> return False
 934           _ -> return True
 935
 936 geWord64# :: Word64# -> Word64# -> Bool
 937 geWord64# x# y# =  unsafePerformIO $ do
 938         v <- _ccall_ stg_geWord64 x# y#
 939         case (v::Int) of
 940           0 -> return False
 941           _ -> return True
 942
 943 gtWord64# :: Word64# -> Word64# -> Bool
 944 gtWord64# x# y# =  unsafePerformIO $ do
 945         v <- _ccall_ stg_gtWord64 x# y#
 946         case (v::Int) of
 947           0 -> return False
 948           _ -> return True
 949
 950 plusInt64# :: Int64# -> Int64# -> Int64#
 951 plusInt64# a# b# =
 952   case (unsafePerformIO (_ccall_ stg_plusInt64 a# b#)) of
 953     I64# i# -> i#
 954
 955 minusInt64# :: Int64# -> Int64# -> Int64#
 956 minusInt64# a# b# =
 957   case (unsafePerformIO (_ccall_ stg_minusInt64 a# b#)) of
 958     I64# i# -> i#
 959
 960 timesInt64# :: Int64# -> Int64# -> Int64#
 961 timesInt64# a# b# =
 962   case (unsafePerformIO (_ccall_ stg_timesInt64 a# b#)) of
 963     I64# i# -> i#
 964
 965 quotWord64# :: Word64# -> Word64# -> Word64#
 966 quotWord64# a# b# =
 967   case (unsafePerformIO (_ccall_ stg_quotWord64 a# b#)) of
 968     W64# w# -> w#
 969
 970 remWord64# :: Word64# -> Word64# -> Word64#
 971 remWord64# a# b# =
 972   case (unsafePerformIO (_ccall_ stg_remWord64 a# b#)) of
 973     W64# w# -> w#
 974
 975 negateInt64# :: Int64# -> Int64#
 976 negateInt64# a# =
 977   case (unsafePerformIO (_ccall_ stg_negateInt64 a#)) of
 978     I64# i# -> i#
 979
 980 and64# :: Word64# -> Word64# -> Word64#
 981 and64# a# b# =
 982   case (unsafePerformIO (_ccall_ stg_and64 a# b#)) of
 983     W64# w# -> w#
 984
 985 or64# :: Word64# -> Word64# -> Word64#
 986 or64# a# b# =
 987   case (unsafePerformIO (_ccall_ stg_or64 a# b#)) of
 988     W64# w# -> w#
 989
 990 xor64# :: Word64# -> Word64# -> Word64#
 991 xor64# a# b# =
 992   case (unsafePerformIO (_ccall_ stg_xor64 a# b#)) of
 993     W64# w# -> w#
 994
 995 not64# :: Word64# -> Word64#
 996 not64# a# =
 997   case (unsafePerformIO (_ccall_ stg_not64 a#)) of
 998     W64# w# -> w#
 999
1000 shiftL64# :: Word64# -> Int# -> Word64#
1001 shiftL64# a# b# =
1002   case (unsafePerformIO (_ccall_ stg_shiftL64 a# b#)) of
1003     W64# w# -> w#
1004
1005 shiftRL64# :: Word64# -> Int# -> Word64#
1006 shiftRL64# a# b# =
1007   case (unsafePerformIO (_ccall_ stg_shiftRL64 a# b#)) of
1008     W64# w# -> w#
1009
1010 word64ToWord# :: Word64# -> Word#
1011 word64ToWord# w# =
1012   case (unsafePerformIO (_ccall_ stg_word64ToWord w#)) of
1013     W# w# -> w#
1014
1015 wordToWord64# :: Word# -> Word64#
1016 wordToWord64# w# =
1017   case (unsafePerformIO (_ccall_ stg_wordToWord64 w#)) of
1018     W64# w# -> w#
1019
1020 word64ToInt64# :: Word64# -> Int64#
1021 word64ToInt64# w# =
1022   case (unsafePerformIO (_ccall_ stg_word64ToInt64 w#)) of
1023     I64# i# -> i#
1024
1025 int64ToWord64# :: Int64# -> Word64#
1026 int64ToWord64# w# =
1027   case (unsafePerformIO (_ccall_ stg_int64ToWord64 w#)) of
1028     W64# w# -> w#
1029
1030 intToInt64# :: Int# -> Int64#
1031 intToInt64# i# =
1032   case (unsafePerformIO (_ccall_ stg_intToInt64 i#)) of
1033     I64# i# -> i#
1034
1035 #endif
1036
1037 sizeofWord64 :: Word32
1038 sizeofWord64 = 8
1039
1040 -- Enum Word64 helper funs:
1041
1042 eftt64 :: Word64 -> Word64 -> (Word64->Bool) -> [Word64]
1043 eftt64 now step done = go now
1044   where
1045    go now
1046      | done now  = []
1047      | otherwise = now : go (now+step)
1048
1049 eft64 :: Word64 -> Word64 -> [Word64]
1050 eft64 now step = go now
1051   where
1052    go x
1053     | x == maxBound = [x]
1054     | otherwise     = x:go (x+step)
1055 \end{code}
1056
1057
1058
1059 The Hugs-GHC extension libraries provide functions for going between
1060 Int and the various (un)signed ints. Here we provide the same for
1061 the GHC specific Word type:
1062
1063 \begin{code}
1064 wordToWord8  :: Word -> Word8
1065 word8ToWord  :: Word8 -> Word
1066 wordToWord16 :: Word -> Word16
1067 word16ToWord :: Word16 -> Word
1068 wordToWord32 :: Word -> Word32
1069 word32ToWord :: Word32 -> Word
1070
1071 word8ToWord (W8# w#)   = W# w#
1072 wordToWord8 (W# w#)    = W8# (w# `and#` (case (maxBound::Word8) of W8# x# -> x#))
1073 word16ToWord (W16# w#) = W# w#
1074 wordToWord16 (W# w#)   = W16# (w# `and#` (case (maxBound::Word16) of W16# x# -> x#))
1075 word32ToWord (W32# w#) = W# w#
1076 wordToWord32 (W# w#)   = W32# (w# `and#` (case (maxBound::Word32) of W32# x# -> x#))
1077
1078 wordToWord64  :: Word -> Word64
1079 wordToWord64 (W# w#) = W64# (wordToWord64# w#)
1080
1081 -- lossy on 32-bit platforms, but provided nontheless.
1082 word64ToWord :: Word64 -> Word
1083 word64ToWord (W64# w#) = W# (word64ToWord# w#)
1084
1085 \end{code}
1086
1087
1088 --End of exported definitions
1089
1090 The remainder of this file consists of definitions which are only
1091 used in the implementation.
1092
1093 \begin{code}
1094 signumReal x | x == 0    =  0
1095              | x > 0     =  1
1096              | otherwise = -1
1097
1098 \end{code}
1099
1100 NOTE: the index is in units of the size of the type, *not* bytes.
1101
1102 \begin{code}
1103 indexWord8OffAddr  :: Addr -> Int -> Word8
1104 indexWord8OffAddr (A# a#) (I# i#) = intToWord8 (I# (ord# (indexCharOffAddr# a# i#)))
1105
1106 indexWord16OffAddr :: Addr -> Int -> Word16
1107 indexWord16OffAddr a i =
1108 #ifdef WORDS_BIGENDIAN
1109   intToWord16 ( word8ToInt l + (word8ToInt maxBound) * word8ToInt h)
1110 #else
1111   intToWord16 ( word8ToInt h + (word8ToInt maxBound) * word8ToInt l)
1112 #endif
1113  where
1114    byte_idx = i * 2
1115    l = indexWord8OffAddr a byte_idx
1116    h = indexWord8OffAddr a (byte_idx+1)
1117
1118 indexWord32OffAddr :: Addr -> Int -> Word32
1119 indexWord32OffAddr (A# a#) i = wordToWord32 (W# (indexWordOffAddr# a# i'#))
1120  where
1121    -- adjust index to be in Word units, not Word32 ones.
1122   (I# i'#)
1123 #if WORD_SIZE_IN_BYTES==8
1124    = i `div` 2
1125 #else
1126    = i
1127 #endif
1128
1129 indexWord64OffAddr :: Addr -> Int -> Word64
1130 indexWord64OffAddr (A# a#) (I# i#)
1131 #if WORD_SIZE_IN_BYTES==8
1132  = W64# (indexWordOffAddr# a# i#)
1133 #else
1134  = W64# (indexWord64OffAddr# a# i#)
1135 #endif
1136
1137 #ifndef __PARALLEL_HASKELL__
1138
1139 indexWord8OffForeignObj  :: ForeignObj -> Int -> Word8
1140 indexWord8OffForeignObj (ForeignObj fo#) (I# i#) = intToWord8 (I# (ord# (indexCharOffForeignObj# fo# i#)))
1141
1142 indexWord16OffForeignObj :: ForeignObj -> Int -> Word16
1143 indexWord16OffForeignObj fo i =
1144 #ifdef WORDS_BIGENDIAN
1145   intToWord16 ( word8ToInt l + (word8ToInt maxBound) * word8ToInt h)
1146 #else
1147   intToWord16 ( word8ToInt h + (word8ToInt maxBound) * word8ToInt l)
1148 #endif
1149  where
1150    byte_idx = i * 2
1151    l = indexWord8OffForeignObj fo byte_idx
1152    h = indexWord8OffForeignObj fo (byte_idx+1)
1153
1154 indexWord32OffForeignObj :: ForeignObj -> Int -> Word32
1155 indexWord32OffForeignObj (ForeignObj fo#) i = wordToWord32 (W# (indexWordOffForeignObj# fo# i'#))
1156  where
1157    -- adjust index to be in Word units, not Word32 ones.
1158   (I# i'#)
1159 #if WORD_SIZE_IN_BYTES==8
1160    = i `div` 2
1161 #else
1162    = i
1163 #endif
1164
1165 indexWord64OffForeignObj :: ForeignObj -> Int -> Word64
1166 indexWord64OffForeignObj (ForeignObj fo#) (I# i#)
1167 #if WORD_SIZE_IN_BYTES==8
1168  = W64# (indexWordOffForeignObj# fo# i#)
1169 #else
1170  = W64# (indexWord64OffForeignObj# fo# i#)
1171 #endif
1172 #endif
1173
1174 \end{code}
1175
1176 Read words out of mutable memory:
1177
1178 \begin{code}
1179 readWord8OffAddr :: Addr -> Int -> IO Word8
1180 readWord8OffAddr a i = _casm_ `` %r=(StgNat8)(((StgNat8*)%0)[(StgInt)%1]); '' a i
1181
1182 readWord16OffAddr  :: Addr -> Int -> IO Word16
1183 readWord16OffAddr a i = _casm_ `` %r=(StgNat16)(((StgNat16*)%0)[(StgInt)%1]); '' a i
1184
1185 readWord32OffAddr  :: Addr -> Int -> IO Word32
1186 readWord32OffAddr a i = _casm_ `` %r=(StgNat32)(((StgNat32*)%0)[(StgInt)%1]); '' a i
1187
1188 readWord64OffAddr  :: Addr -> Int -> IO Word64
1189 #if WORD_SIZE_IN_BYTES==8
1190 readWord64OffAddr a i = _casm_ `` %r=(StgWord)(((StgWord*)%0)[(StgInt)%1]); '' a i
1191 #else
1192 readWord64OffAddr a i = _casm_ `` %r=(StgNat64)(((StgNat64*)%0)[(StgInt)%1]); '' a i
1193 #endif
1194
1195 #ifndef __PARALLEL_HASKELL__
1196 readWord8OffForeignObj :: ForeignObj -> Int -> IO Word8
1197 readWord8OffForeignObj fo i = _casm_ `` %r=(StgNat8)(((StgNat8*)%0)[(StgInt)%1]); '' fo i
1198
1199 readWord16OffForeignObj  :: ForeignObj -> Int -> IO Word16
1200 readWord16OffForeignObj fo i = _casm_ `` %r=(StgNat16)(((StgNat16*)%0)[(StgInt)%1]); '' fo i
1201
1202 readWord32OffForeignObj  :: ForeignObj -> Int -> IO Word32
1203 readWord32OffForeignObj fo i = _casm_ `` %r=(StgNat32)(((StgNat32*)%0)[(StgInt)%1]); '' fo i
1204
1205 readWord64OffForeignObj  :: ForeignObj -> Int -> IO Word64
1206 #if WORD_SIZE_IN_BYTES==8
1207 readWord64OffForeignObj fo i = _casm_ `` %r=(StgWord)(((StgWord*)%0)[(StgInt)%1]); '' fo i
1208 #else
1209 readWord64OffForeignObj fo i = _casm_ `` %r=(StgNat64)(((StgNat64*)%0)[(StgInt)%1]); '' fo i
1210 #endif
1211
1212 #endif
1213
1214 \end{code}
1215
1216 Note: we provide primops for the writing via Addrs since that's used
1217 in the IO implementation (a place where we *really* do care about cycles.)
1218
1219 \begin{code}
1220 writeWord8OffAddr  :: Addr -> Int -> Word8  -> IO ()
1221 writeWord8OffAddr (A# a#) (I# i#) (W8# w#) = IO $ \ s# ->
1222       case (writeCharOffAddr# a# i# (chr# (word2Int# w#)) s#) of s2# -> (# s2#, () #)
1223
1224 writeWord16OffAddr :: Addr -> Int -> Word16 -> IO ()
1225 writeWord16OffAddr a i e = _casm_ `` (((StgNat16*)%0)[(StgInt)%1])=(StgNat16)%2; '' a i e
1226
1227 writeWord32OffAddr :: Addr -> Int -> Word32 -> IO ()
1228 writeWord32OffAddr (A# a#) i@(I# i#) (W32# w#) = IO $ \ s# ->
1229       case (writeWordOffAddr#  a# i'# w# s#) of s2# -> (# s2#, () #)
1230  where
1231    -- adjust index to be in Word units, not Word32 ones.
1232   (I# i'#)
1233 #if WORD_SIZE_IN_BYTES==8
1234    = i `div` 2
1235 #else
1236    = i
1237 #endif
1238
1239 writeWord64OffAddr :: Addr -> Int -> Word64 -> IO ()
1240 #if WORD_SIZE_IN_BYTES==8
1241 writeWord64OffAddr (A# a#) (I# i#) (W64# w#) = IO $ \ s# ->
1242       case (writeWordOffAddr#  a# i# w# s#) of s2# -> (# s2#, () #)
1243 #else
1244 writeWord64OffAddr (A# a#) (I# i#) (W64# w#) = IO $ \ s# ->
1245       case (writeWord64OffAddr#  a# i# w# s#) of s2# -> (# s2#, () #)
1246 #endif
1247
1248 #ifndef __PARALLEL_HASKELL__
1249
1250 writeWord8OffForeignObj  :: ForeignObj -> Int -> Word8  -> IO ()
1251 writeWord8OffForeignObj fo i w = _casm_ `` (((StgNat16*)%0)[(StgInt)%1])=(StgNat16)%2; '' fo i w
1252
1253 writeWord16OffForeignObj :: ForeignObj -> Int -> Word16 -> IO ()
1254 writeWord16OffForeignObj fo i w = _casm_ `` (((StgNat16*)%0)[(StgInt)%1])=(StgNat16)%2; '' fo i w
1255
1256 writeWord32OffForeignObj :: ForeignObj -> Int -> Word32 -> IO ()
1257 writeWord32OffForeignObj fo i w = _casm_ `` (((StgNat16*)%0)[(StgInt)%1])=(StgNat16)%2; '' fo i' w
1258  where
1259    -- adjust index to be in Word units, not Word32 ones.
1260   i'
1261 #if WORD_SIZE_IN_BYTES==8
1262    = i `div` 2
1263 #else
1264    = i
1265 #endif
1266
1267 writeWord64OffForeignObj :: ForeignObj -> Int -> Word64 -> IO ()
1268 # if WORD_SIZE_IN_BYTES==8
1269 writeWord64OffForeignObj fo i e = _casm_ `` (((StgWord*)%0)[(StgInt)%1])=(StgWord)%2; '' fo i e
1270 # else
1271 writeWord64OffForeignObj fo i e = _casm_ `` (((StgNat64*)%0)[(StgInt)%1])=(StgNat64)%2; '' fo i e
1272 # endif
1273
1274 #endif
1275
1276 \end{code}