Literal.hs 19.6 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 FastTypes
52
import FastString
53
import BasicTypes
54
import Binary
55
import Constants
56
import DynFlags
57
import UniqFM
58 59
import Util

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

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

76 77 78 79 80 81
-- | 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.
--
82
-- * The literal derived from the label mentioned in a \"foreign label\"
83
--   declaration ('MachLabel')
84
data Literal
85 86 87
  =     ------------------
        -- First the primitive guys
    MachChar    Char            -- ^ @Char#@ - at least 31 bits. Create with 'mkMachChar'
88

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

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

98 99 100 101
  | 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'
102

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

  | MachLabel   FastString
107
                (Maybe Int)
108 109
        FunctionOrData
                -- ^ A label literal. Parameters:
110 111 112 113 114 115 116
                        --
                        -- 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.
117

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

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

129 130 131 132
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.
133

134 135 136 137 138
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.
139 140


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

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
147
    put_ bh (MachNullAddr)    = do putByte bh 2
148 149 150 151 152 153
    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
154 155 156 157 158
    put_ bh (MachLabel aj mb fod)
        = do putByte bh 9
             put_ bh aj
             put_ bh mb
             put_ bh fod
159
    put_ bh (LitInteger i _) = do putByte bh 10; put_ bh i
160
    get bh = do
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 188
            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)
189
              9 -> do
190 191 192 193
                    aj <- get bh
                    mb <- get bh
                    fod <- get bh
                    return (MachLabel aj mb fod)
194 195
              _ -> do
                    i <- get bh
196
                    -- See Note [Integer literals]
197
                    return $ mkLitInteger i (panic "Evaluated the place holder for mkInteger")
198

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

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 }
208
    a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
209
    a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
210
    a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
211 212
    compare a b = cmpLit a b

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

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

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

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

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

236 237 238 239 240 241 242 243 244 245 246 247 248 249 250
-- | 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
251
-- stored UTF-8 encoded
252
mkMachString s = MachStr (fastStringToByteString $ mkFastString s)
253

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

257 258 259
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
260

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

264
-- | Tests whether the literal represents a zero of whatever type it is
265 266 267 268 269 270 271
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
272
isZeroLit _              = False
273

274 275 276 277 278 279 280 281 282 283 284
-- | 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
285
{-
286 287
        Coercions
        ~~~~~~~~~
Austin Seipp's avatar
Austin Seipp committed
288 289
-}

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

297 298 299 300 301
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)
302

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

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

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

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

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

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

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

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

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

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

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

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

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

379
-- | Find the Haskell 'Type' the literal occupies
380
literalType :: Literal -> Type
381 382 383 384 385 386 387 388 389
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
390
literalType (MachLabel _ _ _) = addrPrimTy
391
literalType (LitInteger _ t) = t
392 393 394 395 396 397 398 399

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)
400 401 402 403 404 405 406
                        , (charPrimTyConKey,    MachChar 'x')
                        , (intPrimTyConKey,     MachInt 0)
                        , (int64PrimTyConKey,   MachInt64 0)
                        , (floatPrimTyConKey,   MachFloat 0)
                        , (doublePrimTyConKey,  MachDouble 0)
                        , (wordPrimTyConKey,    MachWord 0)
                        , (word64PrimTyConKey,  MachWord64 0) ]
407

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

413
cmpLit :: Literal -> Literal -> Ordering
414 415
cmpLit (MachChar      a)   (MachChar       b)   = a `compare` b
cmpLit (MachStr       a)   (MachStr        b)   = a `compare` b
sof's avatar
sof committed
416
cmpLit (MachNullAddr)      (MachNullAddr)       = EQ
417 418 419 420 421 422
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
423
cmpLit (MachLabel     a _ _) (MachLabel      b _ _) = a `compare` b
424
cmpLit (LitInteger    a _) (LitInteger     b _) = a `compare` b
425 426
cmpLit lit1                lit2                 | litTag lit1 <# litTag lit2 = LT
                                                | otherwise                  = GT
427

428
litTag :: Literal -> FastInt
429 430
litTag (MachChar      _)   = _ILIT(1)
litTag (MachStr       _)   = _ILIT(2)
sof's avatar
sof committed
431
litTag (MachNullAddr)      = _ILIT(3)
432 433 434 435 436 437
litTag (MachInt       _)   = _ILIT(4)
litTag (MachWord      _)   = _ILIT(5)
litTag (MachInt64     _)   = _ILIT(6)
litTag (MachWord64    _)   = _ILIT(7)
litTag (MachFloat     _)   = _ILIT(8)
litTag (MachDouble    _)   = _ILIT(9)
438
litTag (MachLabel _ _ _)   = _ILIT(10)
439
litTag (LitInteger  {})    = _ILIT(11)
440

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

447
pprLiteral :: (SDoc -> SDoc) -> Literal -> SDoc
448
pprLiteral _       (MachChar c)     = pprPrimChar c
449
pprLiteral _       (MachStr s)      = pprHsBytes s
450
pprLiteral _       (MachNullAddr)   = ptext (sLit "__NULL")
451 452 453 454 455 456 457
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
458
pprLiteral add_par (MachLabel l mb fod) = add_par (ptext (sLit "__label") <+> b <+> ppr fod)
459 460 461
    where b = case mb of
              Nothing -> pprHsString l
              Just x  -> doubleQuotes (text (unpackFS l ++ '@':show x))
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 503
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" ...)
-}
504

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

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
514
-}
515 516

hashLiteral :: Literal -> Int
517
hashLiteral (MachChar c)        = ord c + 1000  -- Keep it out of range of common ints
518
hashLiteral (MachStr s)         = hashByteString s
519 520 521 522 523 524 525
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
526
hashLiteral (MachLabel s _ _)     = hashFS s
527
hashLiteral (LitInteger i _)    = hashInteger i
528 529 530 531 532 533

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

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

537
hashFS :: FastString -> Int
538
hashFS s = iBox (uniqueOfFS s)