Literal.hs 19.5 KB
Newer Older
Austin Seipp's avatar
Austin Seipp committed
1 2 3 4
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1998

5
\section[Literal]{@Literal@: Machine literals (unboxed, of course)}
Austin Seipp's avatar
Austin Seipp committed
6
-}
7

8
{-# LANGUAGE CPP, DeriveDataTypeable #-}
9

10
module Literal
11 12 13 14 15 16 17 18 19
        (
        -- * Main data type
          Literal(..)           -- Exported to ParseIface

        -- ** Creating Literals
        , mkMachInt, mkMachWord
        , mkMachInt64, mkMachWord64
        , mkMachFloat, mkMachDouble
        , mkMachChar, mkMachString
20
        , mkLitInteger
21 22 23 24

        -- ** Operations on Literals
        , literalType
        , hashLiteral
25
        , absentLiteralOf
26
        , pprLiteral
27

28
        -- ** Predicates on Literals and their contents
29
        , litIsDupable, litIsTrivial, litIsLifted
30 31 32
        , inIntRange, inWordRange, tARGET_MAX_INT, inCharRange
        , isZeroLit
        , litFitsInChar
33
        , litValue
34

35
        -- ** Coercions
36 37 38 39 40 41 42
        , word2IntLit, int2WordLit
        , narrow8IntLit, narrow16IntLit, narrow32IntLit
        , narrow8WordLit, narrow16WordLit, narrow32WordLit
        , char2IntLit, int2CharLit
        , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
        , nullAddrLit, float2DoubleLit, double2FloatLit
        ) where
43

Ian Lynagh's avatar
Ian Lynagh committed
44 45
#include "HsVersions.h"

Simon Marlow's avatar
Simon Marlow committed
46
import TysPrim
47
import PrelNames
Simon Marlow's avatar
Simon Marlow committed
48
import Type
49
import TyCon
50
import Outputable
51
import FastString
52
import BasicTypes
53
import Binary
54
import Constants
55
import DynFlags
56
import UniqFM
57 58
import Util

59
import Data.ByteString (ByteString)
Simon Marlow's avatar
Simon Marlow committed
60
import Data.Int
Ian Lynagh's avatar
Ian Lynagh committed
61
import Data.Ratio
Simon Marlow's avatar
Simon Marlow committed
62 63
import Data.Word
import Data.Char
64 65
import Data.Data ( Data, Typeable )
import Numeric ( fromRat )
66

Austin Seipp's avatar
Austin Seipp committed
67 68 69
{-
************************************************************************
*                                                                      *
70
\subsection{Literals}
Austin Seipp's avatar
Austin Seipp committed
71 72 73
*                                                                      *
************************************************************************
-}
74

75 76 77 78 79 80
-- | So-called 'Literal's are one of:
--
-- * An unboxed (/machine/) literal ('MachInt', 'MachFloat', etc.),
--   which is presumed to be surrounded by appropriate constructors
--   (@Int#@, etc.), so that the overall thing makes sense.
--
81
-- * The literal derived from the label mentioned in a \"foreign label\"
82
--   declaration ('MachLabel')
83
data Literal
84 85 86
  =     ------------------
        -- First the primitive guys
    MachChar    Char            -- ^ @Char#@ - at least 31 bits. Create with 'mkMachChar'
87

88
  | MachStr     ByteString      -- ^ A string-literal: stored and emitted
89 90 91
                                -- UTF-8 encoded, we'll arrange to decode it
                                -- at runtime.  Also emitted with a @'\0'@
                                -- terminator. Create with 'mkMachString'
92 93

  | MachNullAddr                -- ^ The @NULL@ pointer, the only pointer value
94
                                -- that can be represented as a Literal. Create
95 96
                                -- with 'nullAddrLit'

97 98 99 100
  | MachInt     Integer         -- ^ @Int#@ - at least @WORD_SIZE_IN_BITS@ bits. Create with 'mkMachInt'
  | MachInt64   Integer         -- ^ @Int64#@ - at least 64 bits. Create with 'mkMachInt64'
  | MachWord    Integer         -- ^ @Word#@ - at least @WORD_SIZE_IN_BITS@ bits. Create with 'mkMachWord'
  | MachWord64  Integer         -- ^ @Word64#@ - at least 64 bits. Create with 'mkMachWord64'
101

102 103
  | MachFloat   Rational        -- ^ @Float#@. Create with 'mkMachFloat'
  | MachDouble  Rational        -- ^ @Double#@. Create with 'mkMachDouble'
104 105

  | MachLabel   FastString
106
                (Maybe Int)
107 108
        FunctionOrData
                -- ^ A label literal. Parameters:
109 110 111 112 113 114 115
                        --
                        -- 1) The name of the symbol mentioned in the declaration
                        --
                        -- 2) The size (in bytes) of the arguments
                                --    the label expects. Only applicable with
                                --    @stdcall@ labels. @Just x@ => @\<x\>@ will
                                --    be appended to label name when emitting assembly.
116

117 118
  | LitInteger Integer Type --  ^ Integer literals
                            -- See Note [Integer literals]
119
  deriving (Data, Typeable)
120

Austin Seipp's avatar
Austin Seipp committed
121
{-
122 123 124
Note [Integer literals]
~~~~~~~~~~~~~~~~~~~~~~~
An Integer literal is represented using, well, an Integer, to make it
125 126
easier to write RULEs for them. They also contain the Integer type, so
that e.g. literalType can return the right Type for them.
127

128 129 130 131
They only get converted into real Core,
    mkInteger [c1, c2, .., cn]
during the CorePrep phase, although TidyPgm looks ahead at what the
core will be, so that it can see whether it involves CAFs.
132

133 134 135 136 137
When we initally build an Integer literal, notably when
deserialising it from an interface file (see the Binary instance
below), we don't have convenient access to the mkInteger Id.  So we
just use an error thunk, and fill in the real Id when we do tcIfaceLit
in TcIface.
138 139


140
Binary instance
Austin Seipp's avatar
Austin Seipp committed
141
-}
142 143 144 145

instance Binary Literal where
    put_ bh (MachChar aa)     = do putByte bh 0; put_ bh aa
    put_ bh (MachStr ab)      = do putByte bh 1; put_ bh ab
sof's avatar
sof committed
146
    put_ bh (MachNullAddr)    = do putByte bh 2
147 148 149 150 151 152
    put_ bh (MachInt ad)      = do putByte bh 3; put_ bh ad
    put_ bh (MachInt64 ae)    = do putByte bh 4; put_ bh ae
    put_ bh (MachWord af)     = do putByte bh 5; put_ bh af
    put_ bh (MachWord64 ag)   = do putByte bh 6; put_ bh ag
    put_ bh (MachFloat ah)    = do putByte bh 7; put_ bh ah
    put_ bh (MachDouble ai)   = do putByte bh 8; put_ bh ai
153 154 155 156 157
    put_ bh (MachLabel aj mb fod)
        = do putByte bh 9
             put_ bh aj
             put_ bh mb
             put_ bh fod
158
    put_ bh (LitInteger i _) = do putByte bh 10; put_ bh i
159
    get bh = do
160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187
            h <- getByte bh
            case h of
              0 -> do
                    aa <- get bh
                    return (MachChar aa)
              1 -> do
                    ab <- get bh
                    return (MachStr ab)
              2 -> do
                    return (MachNullAddr)
              3 -> do
                    ad <- get bh
                    return (MachInt ad)
              4 -> do
                    ae <- get bh
                    return (MachInt64 ae)
              5 -> do
                    af <- get bh
                    return (MachWord af)
              6 -> do
                    ag <- get bh
                    return (MachWord64 ag)
              7 -> do
                    ah <- get bh
                    return (MachFloat ah)
              8 -> do
                    ai <- get bh
                    return (MachDouble ai)
188
              9 -> do
189 190 191 192
                    aj <- get bh
                    mb <- get bh
                    fod <- get bh
                    return (MachLabel aj mb fod)
193 194
              _ -> do
                    i <- get bh
195
                    -- See Note [Integer literals]
196
                    return $ mkLitInteger i (panic "Evaluated the place holder for mkInteger")
197

198
instance Outputable Literal where
199
    ppr lit = pprLiteral (\d -> d) lit
200 201 202 203 204 205 206

instance Eq Literal where
    a == b = case (a `compare` b) of { EQ -> True;   _ -> False }
    a /= b = case (a `compare` b) of { EQ -> False;  _ -> True  }

instance Ord Literal where
    a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
207
    a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
208
    a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
209
    a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
210 211
    compare a b = cmpLit a b

Austin Seipp's avatar
Austin Seipp committed
212
{-
213 214
        Construction
        ~~~~~~~~~~~~
Austin Seipp's avatar
Austin Seipp committed
215 216
-}

217
-- | Creates a 'Literal' of type @Int#@
218 219 220
mkMachInt :: DynFlags -> Integer -> Literal
mkMachInt dflags x   = ASSERT2( inIntRange dflags x,  integer x )
                       MachInt x
221 222

-- | Creates a 'Literal' of type @Word#@
223 224 225
mkMachWord :: DynFlags -> Integer -> Literal
mkMachWord dflags x   = ASSERT2( inWordRange dflags x, integer x )
                        MachWord x
226 227 228

-- | Creates a 'Literal' of type @Int64#@
mkMachInt64 :: Integer -> Literal
229
mkMachInt64  x = MachInt64 x
230 231 232

-- | Creates a 'Literal' of type @Word64#@
mkMachWord64 :: Integer -> Literal
233
mkMachWord64 x = MachWord64 x
234

235 236 237 238 239 240 241 242 243 244 245 246 247 248 249
-- | Creates a 'Literal' of type @Float#@
mkMachFloat :: Rational -> Literal
mkMachFloat = MachFloat

-- | Creates a 'Literal' of type @Double#@
mkMachDouble :: Rational -> Literal
mkMachDouble = MachDouble

-- | Creates a 'Literal' of type @Char#@
mkMachChar :: Char -> Literal
mkMachChar = MachChar

-- | Creates a 'Literal' of type @Addr#@, which is appropriate for passing to
-- e.g. some of the \"error\" functions in GHC.Err such as @GHC.Err.runtimeError@
mkMachString :: String -> Literal
250
-- stored UTF-8 encoded
251
mkMachString s = MachStr (fastStringToByteString $ mkFastString s)
252

253
mkLitInteger :: Integer -> Type -> Literal
254 255
mkLitInteger = LitInteger

256 257 258
inIntRange, inWordRange :: DynFlags -> Integer -> Bool
inIntRange  dflags x = x >= tARGET_MIN_INT dflags && x <= tARGET_MAX_INT dflags
inWordRange dflags x = x >= 0                     && x <= tARGET_MAX_WORD dflags
259

260 261
inCharRange :: Char -> Bool
inCharRange c =  c >= '\0' && c <= chr tARGET_MAX_CHAR
262

263
-- | Tests whether the literal represents a zero of whatever type it is
264 265 266 267 268 269 270
isZeroLit :: Literal -> Bool
isZeroLit (MachInt    0) = True
isZeroLit (MachInt64  0) = True
isZeroLit (MachWord   0) = True
isZeroLit (MachWord64 0) = True
isZeroLit (MachFloat  0) = True
isZeroLit (MachDouble 0) = True
271
isZeroLit _              = False
272

273 274 275 276 277 278 279 280 281 282 283
-- | Returns the 'Integer' contained in the 'Literal', for when that makes
-- sense, i.e. for 'Char', 'Int', 'Word' and 'LitInteger'.
litValue  :: Literal -> Integer
litValue (MachChar   c) = toInteger $ ord c
litValue (MachInt    i) = i
litValue (MachInt64  i) = i
litValue (MachWord   i) = i
litValue (MachWord64 i) = i
litValue (LitInteger i _) = i
litValue l = pprPanic "litValue" (ppr l)

Austin Seipp's avatar
Austin Seipp committed
284
{-
285 286
        Coercions
        ~~~~~~~~~
Austin Seipp's avatar
Austin Seipp committed
287 288
-}

289
narrow8IntLit, narrow16IntLit, narrow32IntLit,
apt's avatar
apt committed
290
  narrow8WordLit, narrow16WordLit, narrow32WordLit,
291 292
  char2IntLit, int2CharLit,
  float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit,
apt's avatar
apt committed
293
  float2DoubleLit, double2FloatLit
294
  :: Literal -> Literal
295

296 297 298 299 300
word2IntLit, int2WordLit :: DynFlags -> Literal -> Literal
word2IntLit dflags (MachWord w)
  | w > tARGET_MAX_INT dflags = MachInt (w - tARGET_MAX_WORD dflags - 1)
  | otherwise                 = MachInt w
word2IntLit _ l = pprPanic "word2IntLit" (ppr l)
301

302 303
int2WordLit dflags (MachInt i)
  | i < 0     = MachWord (1 + tARGET_MAX_WORD dflags + i)      -- (-1)  --->  tARGET_MAX_WORD
304
  | otherwise = MachWord i
305
int2WordLit _ l = pprPanic "int2WordLit" (ppr l)
306

apt's avatar
apt committed
307
narrow8IntLit    (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int8))
308
narrow8IntLit    l            = pprPanic "narrow8IntLit" (ppr l)
apt's avatar
apt committed
309
narrow16IntLit   (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int16))
310
narrow16IntLit   l            = pprPanic "narrow16IntLit" (ppr l)
apt's avatar
apt committed
311
narrow32IntLit   (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int32))
312
narrow32IntLit   l            = pprPanic "narrow32IntLit" (ppr l)
apt's avatar
apt committed
313
narrow8WordLit   (MachWord w) = MachWord (toInteger (fromInteger w :: Word8))
314
narrow8WordLit   l            = pprPanic "narrow8WordLit" (ppr l)
apt's avatar
apt committed
315
narrow16WordLit  (MachWord w) = MachWord (toInteger (fromInteger w :: Word16))
316
narrow16WordLit  l            = pprPanic "narrow16WordLit" (ppr l)
apt's avatar
apt committed
317
narrow32WordLit  (MachWord w) = MachWord (toInteger (fromInteger w :: Word32))
318
narrow32WordLit  l            = pprPanic "narrow32WordLit" (ppr l)
319

320
char2IntLit (MachChar c) = MachInt  (toInteger (ord c))
321
char2IntLit l            = pprPanic "char2IntLit" (ppr l)
322
int2CharLit (MachInt  i) = MachChar (chr (fromInteger i))
323
int2CharLit l            = pprPanic "int2CharLit" (ppr l)
324

325
float2IntLit (MachFloat f) = MachInt   (truncate    f)
326
float2IntLit l             = pprPanic "float2IntLit" (ppr l)
327
int2FloatLit (MachInt   i) = MachFloat (fromInteger i)
328
int2FloatLit l             = pprPanic "int2FloatLit" (ppr l)
329

apt's avatar
apt committed
330
double2IntLit (MachDouble f) = MachInt    (truncate    f)
331 332 333
double2IntLit l              = pprPanic "double2IntLit" (ppr l)
int2DoubleLit (MachInt    i) = MachDouble (fromInteger i)
int2DoubleLit l              = pprPanic "int2DoubleLit" (ppr l)
334 335

float2DoubleLit (MachFloat  f) = MachDouble f
336
float2DoubleLit l              = pprPanic "float2DoubleLit" (ppr l)
337
double2FloatLit (MachDouble d) = MachFloat  d
338
double2FloatLit l              = pprPanic "double2FloatLit" (ppr l)
apt's avatar
apt committed
339 340

nullAddrLit :: Literal
sof's avatar
sof committed
341
nullAddrLit = MachNullAddr
342

Austin Seipp's avatar
Austin Seipp committed
343
{-
344 345
        Predicates
        ~~~~~~~~~~
Austin Seipp's avatar
Austin Seipp committed
346 347
-}

348 349
-- | True if there is absolutely no penalty to duplicating the literal.
-- False principally of strings
350
litIsTrivial :: Literal -> Bool
351
--      c.f. CoreUtils.exprIsTrivial
352 353 354
litIsTrivial (MachStr _)      = False
litIsTrivial (LitInteger {})  = False
litIsTrivial _                = True
355

356 357
-- | True if code space does not go bad if we duplicate this literal
-- Currently we treat it just like 'litIsTrivial'
358
litIsDupable :: DynFlags -> Literal -> Bool
359
--      c.f. CoreUtils.exprIsDupable
360 361 362
litIsDupable _      (MachStr _)      = False
litIsDupable dflags (LitInteger i _) = inIntRange dflags i
litIsDupable _      _                = True
363

364
litFitsInChar :: Literal -> Bool
ian@well-typed.com's avatar
ian@well-typed.com committed
365 366 367
litFitsInChar (MachInt i) = i >= toInteger (ord minBound)
                         && i <= toInteger (ord maxBound)
litFitsInChar _           = False
368 369 370 371

litIsLifted :: Literal -> Bool
litIsLifted (LitInteger {}) = True
litIsLifted _               = False
372

Austin Seipp's avatar
Austin Seipp committed
373
{-
374 375
        Types
        ~~~~~
Austin Seipp's avatar
Austin Seipp committed
376 377
-}

378
-- | Find the Haskell 'Type' the literal occupies
379
literalType :: Literal -> Type
380 381 382 383 384 385 386 387 388
literalType MachNullAddr    = addrPrimTy
literalType (MachChar _)    = charPrimTy
literalType (MachStr  _)    = addrPrimTy
literalType (MachInt  _)    = intPrimTy
literalType (MachWord  _)   = wordPrimTy
literalType (MachInt64  _)  = int64PrimTy
literalType (MachWord64  _) = word64PrimTy
literalType (MachFloat _)   = floatPrimTy
literalType (MachDouble _)  = doublePrimTy
389
literalType (MachLabel _ _ _) = addrPrimTy
390
literalType (LitInteger _ t) = t
391 392 393 394 395 396 397 398

absentLiteralOf :: TyCon -> Maybe Literal
-- Return a literal of the appropriate primtive
-- TyCon, to use as a placeholder when it doesn't matter
absentLiteralOf tc = lookupUFM absent_lits (tyConName tc)

absent_lits :: UniqFM Literal
absent_lits = listToUFM [ (addrPrimTyConKey,    MachNullAddr)
399 400 401 402 403 404 405
                        , (charPrimTyConKey,    MachChar 'x')
                        , (intPrimTyConKey,     MachInt 0)
                        , (int64PrimTyConKey,   MachInt64 0)
                        , (floatPrimTyConKey,   MachFloat 0)
                        , (doublePrimTyConKey,  MachDouble 0)
                        , (wordPrimTyConKey,    MachWord 0)
                        , (word64PrimTyConKey,  MachWord64 0) ]
406

Austin Seipp's avatar
Austin Seipp committed
407
{-
408 409
        Comparison
        ~~~~~~~~~~
Austin Seipp's avatar
Austin Seipp committed
410 411
-}

412
cmpLit :: Literal -> Literal -> Ordering
413 414
cmpLit (MachChar      a)   (MachChar       b)   = a `compare` b
cmpLit (MachStr       a)   (MachStr        b)   = a `compare` b
sof's avatar
sof committed
415
cmpLit (MachNullAddr)      (MachNullAddr)       = EQ
416 417 418 419 420 421
cmpLit (MachInt       a)   (MachInt        b)   = a `compare` b
cmpLit (MachWord      a)   (MachWord       b)   = a `compare` b
cmpLit (MachInt64     a)   (MachInt64      b)   = a `compare` b
cmpLit (MachWord64    a)   (MachWord64     b)   = a `compare` b
cmpLit (MachFloat     a)   (MachFloat      b)   = a `compare` b
cmpLit (MachDouble    a)   (MachDouble     b)   = a `compare` b
422
cmpLit (MachLabel     a _ _) (MachLabel      b _ _) = a `compare` b
423
cmpLit (LitInteger    a _) (LitInteger     b _) = a `compare` b
424 425 426 427 428 429 430 431 432 433 434 435 436 437 438
cmpLit lit1                lit2                 | litTag lit1 < litTag lit2 = LT
                                                | otherwise                 = GT

litTag :: Literal -> Int
litTag (MachChar      _)   = 1
litTag (MachStr       _)   = 2
litTag (MachNullAddr)      = 3
litTag (MachInt       _)   = 4
litTag (MachWord      _)   = 5
litTag (MachInt64     _)   = 6
litTag (MachWord64    _)   = 7
litTag (MachFloat     _)   = 8
litTag (MachDouble    _)   = 9
litTag (MachLabel _ _ _)   = 10
litTag (LitInteger  {})    = 11
439

Austin Seipp's avatar
Austin Seipp committed
440
{-
441 442
        Printing
        ~~~~~~~~
443
* See Note [Printing of literals in Core]
Austin Seipp's avatar
Austin Seipp committed
444
-}
445

446
pprLiteral :: (SDoc -> SDoc) -> Literal -> SDoc
447
pprLiteral _       (MachChar c)     = pprPrimChar c
448
pprLiteral _       (MachStr s)      = pprHsBytes s
449
pprLiteral _       (MachNullAddr)   = ptext (sLit "__NULL")
450 451 452 453 454 455 456
pprLiteral _       (MachInt i)      = pprPrimInt i
pprLiteral _       (MachInt64 i)    = pprPrimInt64 i
pprLiteral _       (MachWord w)     = pprPrimWord w
pprLiteral _       (MachWord64 w)   = pprPrimWord64 w
pprLiteral _       (MachFloat f)    = float (fromRat f) <> primFloatSuffix
pprLiteral _       (MachDouble d)   = double (fromRat d) <> primDoubleSuffix
pprLiteral add_par (LitInteger i _) = pprIntegerVal add_par i
457
pprLiteral add_par (MachLabel l mb fod) = add_par (ptext (sLit "__label") <+> b <+> ppr fod)
458 459 460
    where b = case mb of
              Nothing -> pprHsString l
              Just x  -> doubleQuotes (text (unpackFS l ++ '@':show x))
461

462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502
pprIntegerVal :: (SDoc -> SDoc) -> Integer -> SDoc
-- See Note [Printing of literals in Core].
pprIntegerVal add_par i | i < 0     = add_par (integer i)
                        | otherwise = integer i

{-
Note [Printing of literals in Core]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The function `add_par` is used to wrap parenthesis around negative integers
(`LitInteger`) and labels (`MachLabel`), if they occur in a context requiring
an atomic thing (for example function application).

Although not all Core literals would be valid Haskell, we are trying to stay
as close as possible to Haskell syntax in the printing of Core, to make it
easier for a Haskell user to read Core.

To that end:
  * We do print parenthesis around negative `LitInteger`, because we print
  `LitInteger` using plain number literals (no prefix or suffix), and plain
  number literals in Haskell require parenthesis in contexts like function
  application (i.e. `1 - -1` is not valid Haskell).

  * We don't print parenthesis around other (negative) literals, because they
  aren't needed in GHC/Haskell either (i.e. `1# -# -1#` is accepted by GHC's
  parser).

Literal         Output             Output if context requires
                                   an atom (if different)
-------         -------            ----------------------
MachChar        'a'#
MachStr         "aaa"#
MachNullAddr    "__NULL"
MachInt         -1#
MachInt64       -1L#
MachWord         1##
MachWord64       1L##
MachFloat       -1.0#
MachDouble      -1.0##
LitInteger      -1                 (-1)
MachLabel       "__label" ...      ("__label" ...)
-}
503

Austin Seipp's avatar
Austin Seipp committed
504 505 506
{-
************************************************************************
*                                                                      *
507
\subsection{Hashing}
Austin Seipp's avatar
Austin Seipp committed
508 509
*                                                                      *
************************************************************************
510 511 512

Hash values should be zero or a positive integer.  No negatives please.
(They mess up the UniqFM for some reason.)
Austin Seipp's avatar
Austin Seipp committed
513
-}
514 515

hashLiteral :: Literal -> Int
516
hashLiteral (MachChar c)        = ord c + 1000  -- Keep it out of range of common ints
517
hashLiteral (MachStr s)         = hashByteString s
518 519 520 521 522 523 524
hashLiteral (MachNullAddr)      = 0
hashLiteral (MachInt i)         = hashInteger i
hashLiteral (MachInt64 i)       = hashInteger i
hashLiteral (MachWord i)        = hashInteger i
hashLiteral (MachWord64 i)      = hashInteger i
hashLiteral (MachFloat r)       = hashRational r
hashLiteral (MachDouble r)      = hashRational r
525
hashLiteral (MachLabel s _ _)     = hashFS s
526
hashLiteral (LitInteger i _)    = hashInteger i
527 528 529 530 531 532

hashRational :: Rational -> Int
hashRational r = hashInteger (numerator r)

hashInteger :: Integer -> Int
hashInteger i = 1 + abs (fromInteger (i `rem` 10000))
533 534
                -- The 1+ is to avoid zero, which is a Bad Number
                -- since we use * to combine hash values
535

536
hashFS :: FastString -> Int
537
hashFS s = uniqueOfFS s