ghc/compiler/basicTypes/Literal.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1998
   3 %
   4 \section[Literal]{@Literal@: Machine literals (unboxed, of course)}
   5
   6 \begin{code}
   7 module Literal
   8         ( Literal(..)           -- Exported to ParseIface
   9         , mkMachInt, mkMachWord
  10         , mkMachInt64, mkMachWord64, mkStringLit
  11         , litSize
  12         , litIsDupable, litIsTrivial
  13         , literalType
  14         , hashLiteral
  15
  16         , inIntRange, inWordRange, tARGET_MAX_INT, inCharRange
  17         , isZeroLit
  18
  19         , word2IntLit, int2WordLit
  20         , narrow8IntLit, narrow16IntLit, narrow32IntLit
  21         , narrow8WordLit, narrow16WordLit, narrow32WordLit
  22         , char2IntLit, int2CharLit
  23         , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
  24         , nullAddrLit, float2DoubleLit, double2FloatLit
  25         ) where
  26
  27 #include "HsVersions.h"
  28
  29 import TysPrim          ( charPrimTy, addrPrimTy, floatPrimTy, doublePrimTy,
  30                           intPrimTy, wordPrimTy, int64PrimTy, word64PrimTy
  31                         )
  32 import Type             ( Type )
  33 import Outputable
  34 import FastTypes
  35 import FastString
  36 import Binary
  37
  38 import Ratio            ( numerator )
  39 import FastString       ( uniqueOfFS, lengthFS )
  40 import DATA_INT         ( Int8,  Int16,  Int32 )
  41 import DATA_WORD        ( Word8, Word16, Word32 )
  42 import Char             ( ord, chr )
  43 \end{code}
  44
  45
  46
  47 %************************************************************************
  48 %*                                                                      *
  49 \subsection{Sizes}
  50 %*                                                                      *
  51 %************************************************************************
  52
  53 If we're compiling with GHC (and we're not cross-compiling), then we
  54 know that minBound and maxBound :: Int are the right values for the
  55 target architecture.  Otherwise, we assume -2^31 and 2^31-1
  56 respectively (which will be wrong on a 64-bit machine).
  57
  58 \begin{code}
  59 tARGET_MIN_INT, tARGET_MAX_INT, tARGET_MAX_WORD :: Integer
  60 #if __GLASGOW_HASKELL__
  61 tARGET_MIN_INT  = toInteger (minBound :: Int)
  62 tARGET_MAX_INT  = toInteger (maxBound :: Int)
  63 #else
  64 tARGET_MIN_INT = -2147483648
  65 tARGET_MAX_INT =  2147483647
  66 #endif
  67 tARGET_MAX_WORD = (tARGET_MAX_INT * 2) + 1
  68
  69 tARGET_MAX_CHAR :: Int
  70 tARGET_MAX_CHAR = 0x10ffff
  71 \end{code}
  72
  73
  74 %************************************************************************
  75 %*                                                                      *
  76 \subsection{Literals}
  77 %*                                                                      *
  78 %************************************************************************
  79
  80 So-called @Literals@ are {\em either}:
  81 \begin{itemize}
  82 \item
  83 An unboxed (``machine'') literal (type: @IntPrim@, @FloatPrim@, etc.),
  84 which is presumed to be surrounded by appropriate constructors
  85 (@mKINT@, etc.), so that the overall thing makes sense.
  86 \item
  87 An Integer, Rational, or String literal whose representation we are
  88 {\em uncommitted} about; i.e., the surrounding with constructors,
  89 function applications, etc., etc., has not yet been done.
  90 \end{itemize}
  91
  92 \begin{code}
  93 data Literal
  94   =     ------------------
  95         -- First the primitive guys
  96     MachChar    Char             -- Char#        At least 31 bits
  97
  98   | MachStr     FastString      -- A string-literal: stored and emitted
  99                                 -- UTF-8 encoded, we'll arrange to decode it
 100                                 -- at runtime.  Also emitted with a '\0'
 101                                 -- terminator.
 102
 103   | MachNullAddr                -- the NULL pointer, the only pointer value
 104                                 -- that can be represented as a Literal.
 105
 106   | MachInt     Integer         -- Int#         At least WORD_SIZE_IN_BITS bits
 107   | MachInt64   Integer         -- Int64#       At least 64 bits
 108   | MachWord    Integer         -- Word#        At least WORD_SIZE_IN_BITS bits
 109   | MachWord64  Integer         -- Word64#      At least 64 bits
 110
 111   | MachFloat   Rational
 112   | MachDouble  Rational
 113
 114         -- MachLabel is used (only) for the literal derived from a
 115         -- "foreign label" declaration.
 116         -- string argument is the name of a symbol.  This literal
 117         -- refers to the *address* of the label.
 118   | MachLabel   FastString              -- always an Addr#
 119                 (Maybe Int)             -- the size (in bytes) of the arguments
 120                                         -- the label expects. Only applicable with
 121                                         -- 'stdcall' labels.
 122                                         -- Just x => "@<x>" will be appended to label
 123                                         --           name when emitting asm.
 124 \end{code}
 125
 126 Binary instance
 127
 128 \begin{code}
 129 instance Binary Literal where
 130     put_ bh (MachChar aa)     = do putByte bh 0; put_ bh aa
 131     put_ bh (MachStr ab)      = do putByte bh 1; put_ bh ab
 132     put_ bh (MachNullAddr)    = do putByte bh 2
 133     put_ bh (MachInt ad)      = do putByte bh 3; put_ bh ad
 134     put_ bh (MachInt64 ae)    = do putByte bh 4; put_ bh ae
 135     put_ bh (MachWord af)     = do putByte bh 5; put_ bh af
 136     put_ bh (MachWord64 ag)   = do putByte bh 6; put_ bh ag
 137     put_ bh (MachFloat ah)    = do putByte bh 7; put_ bh ah
 138     put_ bh (MachDouble ai)   = do putByte bh 8; put_ bh ai
 139     put_ bh (MachLabel aj mb) = do putByte bh 9; put_ bh aj ; put_ bh mb
 140     get bh = do
 141             h <- getByte bh
 142             case h of
 143               0 -> do
 144                     aa <- get bh
 145                     return (MachChar aa)
 146               1 -> do
 147                     ab <- get bh
 148                     return (MachStr ab)
 149               2 -> do
 150                     return (MachNullAddr)
 151               3 -> do
 152                     ad <- get bh
 153                     return (MachInt ad)
 154               4 -> do
 155                     ae <- get bh
 156                     return (MachInt64 ae)
 157               5 -> do
 158                     af <- get bh
 159                     return (MachWord af)
 160               6 -> do
 161                     ag <- get bh
 162                     return (MachWord64 ag)
 163               7 -> do
 164                     ah <- get bh
 165                     return (MachFloat ah)
 166               8 -> do
 167                     ai <- get bh
 168                     return (MachDouble ai)
 169               9 -> do
 170                     aj <- get bh
 171                     mb <- get bh
 172                     return (MachLabel aj mb)
 173 \end{code}
 174
 175 \begin{code}
 176 instance Outputable Literal where
 177     ppr lit = pprLit lit
 178
 179 instance Show Literal where
 180     showsPrec p lit = showsPrecSDoc p (ppr lit)
 181
 182 instance Eq Literal where
 183     a == b = case (a `compare` b) of { EQ -> True;   _ -> False }
 184     a /= b = case (a `compare` b) of { EQ -> False;  _ -> True  }
 185
 186 instance Ord Literal where
 187     a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
 188     a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
 189     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
 190     a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
 191     compare a b = cmpLit a b
 192 \end{code}
 193
 194
 195         Construction
 196         ~~~~~~~~~~~~
 197 \begin{code}
 198 mkMachInt, mkMachWord, mkMachInt64, mkMachWord64 :: Integer -> Literal
 199
 200 mkMachInt  x   = -- ASSERT2( inIntRange x,  integer x )
 201                  -- Not true: you can write out of range Int# literals
 202                  -- For example, one can write (intToWord# 0xffff0000) to
 203                  -- get a particular Word bit-pattern, and there's no other
 204                  -- convenient way to write such literals, which is why we allow it.
 205                  MachInt x
 206 mkMachWord x   = -- ASSERT2( inWordRange x, integer x )
 207                  MachWord x
 208 mkMachInt64  x = MachInt64 x
 209 mkMachWord64 x = MachWord64 x
 210
 211 mkStringLit :: String -> Literal
 212 mkStringLit s = MachStr (mkFastString s) -- stored UTF-8 encoded
 213
 214 inIntRange, inWordRange :: Integer -> Bool
 215 inIntRange  x = x >= tARGET_MIN_INT && x <= tARGET_MAX_INT
 216 inWordRange x = x >= 0              && x <= tARGET_MAX_WORD
 217
 218 inCharRange :: Char -> Bool
 219 inCharRange c =  c >= '\0' && c <= chr tARGET_MAX_CHAR
 220
 221 isZeroLit :: Literal -> Bool
 222 isZeroLit (MachInt    0) = True
 223 isZeroLit (MachInt64  0) = True
 224 isZeroLit (MachWord   0) = True
 225 isZeroLit (MachWord64 0) = True
 226 isZeroLit (MachFloat  0) = True
 227 isZeroLit (MachDouble 0) = True
 228 isZeroLit other          = False
 229 \end{code}
 230
 231         Coercions
 232         ~~~~~~~~~
 233 \begin{code}
 234 word2IntLit, int2WordLit,
 235   narrow8IntLit, narrow16IntLit, narrow32IntLit,
 236   narrow8WordLit, narrow16WordLit, narrow32WordLit,
 237   char2IntLit, int2CharLit,
 238   float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit,
 239   float2DoubleLit, double2FloatLit
 240   :: Literal -> Literal
 241
 242 word2IntLit (MachWord w)
 243   | w > tARGET_MAX_INT = MachInt (w - tARGET_MAX_WORD - 1)
 244   | otherwise          = MachInt w
 245
 246 int2WordLit (MachInt i)
 247   | i < 0     = MachWord (1 + tARGET_MAX_WORD + i)      -- (-1)  --->  tARGET_MAX_WORD
 248   | otherwise = MachWord i
 249
 250 narrow8IntLit    (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int8))
 251 narrow16IntLit   (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int16))
 252 narrow32IntLit   (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int32))
 253 narrow8WordLit   (MachWord w) = MachWord (toInteger (fromInteger w :: Word8))
 254 narrow16WordLit  (MachWord w) = MachWord (toInteger (fromInteger w :: Word16))
 255 narrow32WordLit  (MachWord w) = MachWord (toInteger (fromInteger w :: Word32))
 256
 257 char2IntLit (MachChar c) = MachInt  (toInteger (ord c))
 258 int2CharLit (MachInt  i) = MachChar (chr (fromInteger i))
 259
 260 float2IntLit (MachFloat f) = MachInt   (truncate    f)
 261 int2FloatLit (MachInt   i) = MachFloat (fromInteger i)
 262
 263 double2IntLit (MachDouble f) = MachInt    (truncate    f)
 264 int2DoubleLit (MachInt   i) = MachDouble (fromInteger i)
 265
 266 float2DoubleLit (MachFloat  f) = MachDouble f
 267 double2FloatLit (MachDouble d) = MachFloat  d
 268
 269 nullAddrLit :: Literal
 270 nullAddrLit = MachNullAddr
 271 \end{code}
 272
 273         Predicates
 274         ~~~~~~~~~~
 275 \begin{code}
 276 litIsTrivial :: Literal -> Bool
 277 -- True if there is absolutely no penalty to duplicating the literal
 278 --      c.f. CoreUtils.exprIsTrivial
 279 -- False principally of strings
 280 litIsTrivial (MachStr _) = False
 281 litIsTrivial other       = True
 282
 283 litIsDupable :: Literal -> Bool
 284 -- True if code space does not go bad if we duplicate this literal
 285 --      c.f. CoreUtils.exprIsDupable
 286 -- Currently we treat it just like litIsTrivial
 287 litIsDupable (MachStr _) = False
 288 litIsDupable other       = True
 289
 290 litSize :: Literal -> Int
 291 -- Used by CoreUnfold.sizeExpr
 292 litSize (MachStr str) = 1 + ((lengthFS str + 3) `div` 4)
 293         -- Every literal has size at least 1, otherwise
 294         --      f "x"
 295         -- might be too small
 296         -- [Sept03: make literal strings a bit bigger to avoid fruitless
 297         --  duplication of little strings]
 298 litSize _other        = 1
 299 \end{code}
 300
 301         Types
 302         ~~~~~
 303 \begin{code}
 304 literalType :: Literal -> Type
 305 literalType MachNullAddr    = addrPrimTy
 306 literalType (MachChar _)    = charPrimTy
 307 literalType (MachStr  _)    = addrPrimTy
 308 literalType (MachInt  _)    = intPrimTy
 309 literalType (MachWord  _)   = wordPrimTy
 310 literalType (MachInt64  _)  = int64PrimTy
 311 literalType (MachWord64  _) = word64PrimTy
 312 literalType (MachFloat _)   = floatPrimTy
 313 literalType (MachDouble _)  = doublePrimTy
 314 literalType (MachLabel _ _) = addrPrimTy
 315 \end{code}
 316
 317
 318         Comparison
 319         ~~~~~~~~~~
 320 \begin{code}
 321 cmpLit (MachChar      a)   (MachChar       b)   = a `compare` b
 322 cmpLit (MachStr       a)   (MachStr        b)   = a `compare` b
 323 cmpLit (MachNullAddr)      (MachNullAddr)       = EQ
 324 cmpLit (MachInt       a)   (MachInt        b)   = a `compare` b
 325 cmpLit (MachWord      a)   (MachWord       b)   = a `compare` b
 326 cmpLit (MachInt64     a)   (MachInt64      b)   = a `compare` b
 327 cmpLit (MachWord64    a)   (MachWord64     b)   = a `compare` b
 328 cmpLit (MachFloat     a)   (MachFloat      b)   = a `compare` b
 329 cmpLit (MachDouble    a)   (MachDouble     b)   = a `compare` b
 330 cmpLit (MachLabel     a _) (MachLabel      b _) = a `compare` b
 331 cmpLit lit1                lit2                 | litTag lit1 <# litTag lit2 = LT
 332                                                 | otherwise                  = GT
 333
 334 litTag (MachChar      _)   = _ILIT(1)
 335 litTag (MachStr       _)   = _ILIT(2)
 336 litTag (MachNullAddr)      = _ILIT(3)
 337 litTag (MachInt       _)   = _ILIT(4)
 338 litTag (MachWord      _)   = _ILIT(5)
 339 litTag (MachInt64     _)   = _ILIT(6)
 340 litTag (MachWord64    _)   = _ILIT(7)
 341 litTag (MachFloat     _)   = _ILIT(8)
 342 litTag (MachDouble    _)   = _ILIT(9)
 343 litTag (MachLabel   _ _)   = _ILIT(10)
 344 \end{code}
 345
 346         Printing
 347         ~~~~~~~~
 348 * MachX (i.e. unboxed) things are printed unadornded (e.g. 3, 'a', "foo")
 349   exceptions: MachFloat gets an initial keyword prefix.
 350
 351 \begin{code}
 352 pprLit (MachChar ch)    = pprHsChar ch
 353 pprLit (MachStr s)      = pprHsString s
 354 pprLit (MachInt i)      = pprIntVal i
 355 pprLit (MachInt64 i)    = ptext SLIT("__int64") <+> integer i
 356 pprLit (MachWord w)     = ptext SLIT("__word") <+> integer w
 357 pprLit (MachWord64 w)   = ptext SLIT("__word64") <+> integer w
 358 pprLit (MachFloat f)    = ptext SLIT("__float") <+> rational f
 359 pprLit (MachDouble d)   = rational d
 360 pprLit (MachNullAddr)   = ptext SLIT("__NULL")
 361 pprLit (MachLabel l mb) = ptext SLIT("__label") <+>
 362                              case mb of
 363                                Nothing -> pprHsString l
 364                                Just x  -> doubleQuotes (text (unpackFS l ++ '@':show x))
 365
 366 pprIntVal :: Integer -> SDoc
 367 -- Print negative integers with parens to be sure it's unambiguous
 368 pprIntVal i | i < 0     = parens (integer i)
 369             | otherwise = integer i
 370 \end{code}
 371
 372
 373 %************************************************************************
 374 %*                                                                      *
 375 \subsection{Hashing}
 376 %*                                                                      *
 377 %************************************************************************
 378
 379 Hash values should be zero or a positive integer.  No negatives please.
 380 (They mess up the UniqFM for some reason.)
 381
 382 \begin{code}
 383 hashLiteral :: Literal -> Int
 384 hashLiteral (MachChar c)        = ord c + 1000  -- Keep it out of range of common ints
 385 hashLiteral (MachStr s)         = hashFS s
 386 hashLiteral (MachNullAddr)      = 0
 387 hashLiteral (MachInt i)         = hashInteger i
 388 hashLiteral (MachInt64 i)       = hashInteger i
 389 hashLiteral (MachWord i)        = hashInteger i
 390 hashLiteral (MachWord64 i)      = hashInteger i
 391 hashLiteral (MachFloat r)       = hashRational r
 392 hashLiteral (MachDouble r)      = hashRational r
 393 hashLiteral (MachLabel s _)     = hashFS s
 394
 395 hashRational :: Rational -> Int
 396 hashRational r = hashInteger (numerator r)
 397
 398 hashInteger :: Integer -> Int
 399 hashInteger i = 1 + abs (fromInteger (i `rem` 10000))
 400                 -- The 1+ is to avoid zero, which is a Bad Number
 401                 -- since we use * to combine hash values
 402
 403 hashFS :: FastString -> Int
 404 hashFS s = iBox (uniqueOfFS s)
 405 \end{code}