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