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