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
  11         , isLitLitLit, maybeLitLit, litSize
  12         , litIsDupable, litIsTrivial
  13         , literalType, literalPrimRep
  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 PrimRep          ( PrimRep(..) )
  33 import TcType           ( Type, tcCmpType )
  34 import Type             ( typePrimRep )
  35 import PprType          ( pprParendType )
  36 import CStrings         ( pprFSInCStyle )
  37
  38 import Outputable
  39 import FastTypes
  40 import FastString
  41 import Binary
  42 import Util             ( thenCmp )
  43
  44 import Ratio            ( numerator )
  45 import FastString       ( uniqueOfFS, lengthFS )
  46 import DATA_INT         ( Int8,  Int16,  Int32 )
  47 import DATA_WORD        ( Word8, Word16, Word32 )
  48 import Char             ( ord, chr )
  49 \end{code}
  50
  51
  52
  53 %************************************************************************
  54 %*                                                                      *
  55 \subsection{Sizes}
  56 %*                                                                      *
  57 %************************************************************************
  58
  59 If we're compiling with GHC (and we're not cross-compiling), then we
  60 know that minBound and maxBound :: Int are the right values for the
  61 target architecture.  Otherwise, we assume -2^31 and 2^31-1
  62 respectively (which will be wrong on a 64-bit machine).
  63
  64 \begin{code}
  65 tARGET_MIN_INT, tARGET_MAX_INT, tARGET_MAX_WORD :: Integer
  66 #if __GLASGOW_HASKELL__
  67 tARGET_MIN_INT  = toInteger (minBound :: Int)
  68 tARGET_MAX_INT  = toInteger (maxBound :: Int)
  69 #else
  70 tARGET_MIN_INT = -2147483648
  71 tARGET_MAX_INT =  2147483647
  72 #endif
  73 tARGET_MAX_WORD = (tARGET_MAX_INT * 2) + 1
  74
  75 tARGET_MAX_CHAR :: Int
  76 tARGET_MAX_CHAR = 0x10ffff
  77 \end{code}
  78
  79
  80 %************************************************************************
  81 %*                                                                      *
  82 \subsection{Literals}
  83 %*                                                                      *
  84 %************************************************************************
  85
  86 So-called @Literals@ are {\em either}:
  87 \begin{itemize}
  88 \item
  89 An unboxed (``machine'') literal (type: @IntPrim@, @FloatPrim@, etc.),
  90 which is presumed to be surrounded by appropriate constructors
  91 (@mKINT@, etc.), so that the overall thing makes sense.
  92 \item
  93 An Integer, Rational, or String literal whose representation we are
  94 {\em uncommitted} about; i.e., the surrounding with constructors,
  95 function applications, etc., etc., has not yet been done.
  96 \end{itemize}
  97
  98 \begin{code}
  99 data Literal
 100   =     ------------------
 101         -- First the primitive guys
 102     MachChar    Int             -- Char#        At least 31 bits
 103   | MachStr     FastString
 104
 105   | MachNullAddr                -- the NULL pointer, the only pointer value
 106                                 -- that can be represented as a Literal.
 107
 108   | MachInt     Integer         -- Int#         At least WORD_SIZE_IN_BITS bits
 109   | MachInt64   Integer         -- Int64#       At least 64 bits
 110   | MachWord    Integer         -- Word#        At least WORD_SIZE_IN_BITS bits
 111   | MachWord64  Integer         -- Word64#      At least 64 bits
 112
 113   | MachFloat   Rational
 114   | MachDouble  Rational
 115
 116         -- MachLabel is used (only) for the literal derived from a
 117         -- "foreign label" declaration.
 118         -- string argument is the name of a symbol.  This literal
 119         -- refers to the *address* of the label.
 120   | MachLabel   FastString              -- always an Addr#
 121                 (Maybe Int)             -- the size (in bytes) of the arguments
 122                                         -- the label expects. Only applicable with
 123                                         -- 'stdcall' labels.
 124                                         -- Just x => "@<x>" will be appended to label
 125                                         --           name when emitting asm.
 126
 127         -- lit-lits only work for via-C compilation, hence they
 128         -- are deprecated.  The string is emitted verbatim into
 129         -- the C file, and can therefore be any C expression,
 130         -- macro call, #defined constant etc.
 131   | MachLitLit  FastString Type -- Type might be Addr# or Int# etc
 132 \end{code}
 133
 134 Binary instance: must do this manually, because we don't want the type
 135 arg of MachLitLit involved.
 136
 137 \begin{code}
 138 instance Binary Literal where
 139     put_ bh (MachChar aa)     = do putByte bh 0; put_ bh aa
 140     put_ bh (MachStr ab)      = do putByte bh 1; put_ bh ab
 141     put_ bh (MachNullAddr)    = do putByte bh 2
 142     put_ bh (MachInt ad)      = do putByte bh 3; put_ bh ad
 143     put_ bh (MachInt64 ae)    = do putByte bh 4; put_ bh ae
 144     put_ bh (MachWord af)     = do putByte bh 5; put_ bh af
 145     put_ bh (MachWord64 ag)   = do putByte bh 6; put_ bh ag
 146     put_ bh (MachFloat ah)    = do putByte bh 7; put_ bh ah
 147     put_ bh (MachDouble ai)   = do putByte bh 8; put_ bh ai
 148     put_ bh (MachLabel aj mb) = do putByte bh 9; put_ bh aj ; put_ bh mb
 149     put_ bh (MachLitLit ak _) = do putByte bh 10; put_ bh ak
 150     get bh = do
 151             h <- getByte bh
 152             case h of
 153               0 -> do
 154                     aa <- get bh
 155                     return (MachChar aa)
 156               1 -> do
 157                     ab <- get bh
 158                     return (MachStr ab)
 159               2 -> do
 160                     return (MachNullAddr)
 161               3 -> do
 162                     ad <- get bh
 163                     return (MachInt ad)
 164               4 -> do
 165                     ae <- get bh
 166                     return (MachInt64 ae)
 167               5 -> do
 168                     af <- get bh
 169                     return (MachWord af)
 170               6 -> do
 171                     ag <- get bh
 172                     return (MachWord64 ag)
 173               7 -> do
 174                     ah <- get bh
 175                     return (MachFloat ah)
 176               8 -> do
 177                     ai <- get bh
 178                     return (MachDouble ai)
 179               9 -> do
 180                     aj <- get bh
 181                     mb <- get bh
 182                     return (MachLabel aj mb)
 183               10 -> do
 184                     ak <- get bh
 185                     return (MachLitLit ak (error "MachLitLit: no type"))
 186 \end{code}
 187
 188 \begin{code}
 189 instance Outputable Literal where
 190     ppr lit = pprLit lit
 191
 192 instance Show Literal where
 193     showsPrec p lit = showsPrecSDoc p (ppr lit)
 194
 195 instance Eq Literal where
 196     a == b = case (a `compare` b) of { EQ -> True;   _ -> False }
 197     a /= b = case (a `compare` b) of { EQ -> False;  _ -> True  }
 198
 199 instance Ord Literal where
 200     a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
 201     a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
 202     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
 203     a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
 204     compare a b = cmpLit a b
 205 \end{code}
 206
 207
 208         Construction
 209         ~~~~~~~~~~~~
 210 \begin{code}
 211 mkMachInt, mkMachWord, mkMachInt64, mkMachWord64 :: Integer -> Literal
 212
 213 mkMachInt  x   = -- ASSERT2( inIntRange x,  integer x )
 214                  -- Not true: you can write out of range Int# literals
 215                  -- For example, one can write (intToWord# 0xffff0000) to
 216                  -- get a particular Word bit-pattern, and there's no other
 217                  -- convenient way to write such literals, which is why we allow it.
 218                  MachInt x
 219 mkMachWord x   = -- ASSERT2( inWordRange x, integer x )
 220                  MachWord x
 221 mkMachInt64  x = MachInt64 x
 222 mkMachWord64 x = MachWord64 x
 223
 224 inIntRange, inWordRange :: Integer -> Bool
 225 inIntRange  x = x >= tARGET_MIN_INT && x <= tARGET_MAX_INT
 226 inWordRange x = x >= 0              && x <= tARGET_MAX_WORD
 227
 228 inCharRange :: Int -> Bool
 229 inCharRange c =  c >= 0 && c <= tARGET_MAX_CHAR
 230
 231 isZeroLit :: Literal -> Bool
 232 isZeroLit (MachInt    0) = True
 233 isZeroLit (MachInt64  0) = True
 234 isZeroLit (MachWord   0) = True
 235 isZeroLit (MachWord64 0) = True
 236 isZeroLit (MachFloat  0) = True
 237 isZeroLit (MachDouble 0) = True
 238 isZeroLit other          = False
 239 \end{code}
 240
 241         Coercions
 242         ~~~~~~~~~
 243 \begin{code}
 244 word2IntLit, int2WordLit,
 245   narrow8IntLit, narrow16IntLit, narrow32IntLit,
 246   narrow8WordLit, narrow16WordLit, narrow32WordLit,
 247   char2IntLit, int2CharLit,
 248   float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit,
 249   float2DoubleLit, double2FloatLit
 250   :: Literal -> Literal
 251
 252 word2IntLit (MachWord w)
 253   | w > tARGET_MAX_INT = MachInt (w - tARGET_MAX_WORD - 1)
 254   | otherwise          = MachInt w
 255
 256 int2WordLit (MachInt i)
 257   | i < 0     = MachWord (1 + tARGET_MAX_WORD + i)      -- (-1)  --->  tARGET_MAX_WORD
 258   | otherwise = MachWord i
 259
 260 narrow8IntLit    (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int8))
 261 narrow16IntLit   (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int16))
 262 narrow32IntLit   (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int32))
 263 narrow8WordLit   (MachWord w) = MachWord (toInteger (fromInteger w :: Word8))
 264 narrow16WordLit  (MachWord w) = MachWord (toInteger (fromInteger w :: Word16))
 265 narrow32WordLit  (MachWord w) = MachWord (toInteger (fromInteger w :: Word32))
 266
 267 char2IntLit (MachChar c) = MachInt  (toInteger c)
 268 int2CharLit (MachInt  i) = MachChar (fromInteger i)
 269
 270 float2IntLit (MachFloat f) = MachInt   (truncate    f)
 271 int2FloatLit (MachInt   i) = MachFloat (fromInteger i)
 272
 273 double2IntLit (MachDouble f) = MachInt    (truncate    f)
 274 int2DoubleLit (MachInt   i) = MachDouble (fromInteger i)
 275
 276 float2DoubleLit (MachFloat  f) = MachDouble f
 277 double2FloatLit (MachDouble d) = MachFloat  d
 278
 279 nullAddrLit :: Literal
 280 nullAddrLit = MachNullAddr
 281 \end{code}
 282
 283         Predicates
 284         ~~~~~~~~~~
 285 \begin{code}
 286 isLitLitLit (MachLitLit _ _) = True
 287 isLitLitLit _                = False
 288
 289 maybeLitLit (MachLitLit s t) = Just (s,t)
 290 maybeLitLit _                = Nothing
 291
 292 litIsTrivial :: Literal -> Bool
 293 -- True if there is absolutely no penalty to duplicating the literal
 294 --      c.f. CoreUtils.exprIsTrivial
 295 -- False principally of strings
 296 litIsTrivial (MachStr _) = False
 297 litIsTrivial other       = True
 298
 299 litIsDupable :: Literal -> Bool
 300 -- True if code space does not go bad if we duplicate this literal
 301 --      c.f. CoreUtils.exprIsDupable
 302 -- Currently we treat it just like litIsTrivial
 303 litIsDupable (MachStr _) = False
 304 litIsDupable other       = True
 305
 306 litSize :: Literal -> Int
 307 -- Used by CoreUnfold.sizeExpr
 308 litSize (MachStr str) = 1 + (lengthFS str `div` 4)
 309         -- Every literal has size at least 1, otherwise
 310         --      f "x"
 311         -- might be too small
 312 litSize _other        = 1
 313 \end{code}
 314
 315         Types
 316         ~~~~~
 317 \begin{code}
 318 literalType :: Literal -> Type
 319 literalType (MachChar _)          = charPrimTy
 320 literalType (MachStr  _)          = addrPrimTy
 321 literalType (MachNullAddr)        = addrPrimTy
 322 literalType (MachInt  _)          = intPrimTy
 323 literalType (MachWord  _)         = wordPrimTy
 324 literalType (MachInt64  _)        = int64PrimTy
 325 literalType (MachWord64  _)       = word64PrimTy
 326 literalType (MachFloat _)         = floatPrimTy
 327 literalType (MachDouble _)        = doublePrimTy
 328 literalType (MachLabel _ _)       = addrPrimTy
 329 literalType (MachLitLit _ ty)     = ty
 330 \end{code}
 331
 332 \begin{code}
 333 literalPrimRep :: Literal -> PrimRep
 334
 335 literalPrimRep (MachChar _)       = CharRep
 336 literalPrimRep (MachStr _)        = AddrRep  -- specifically: "char *"
 337 literalPrimRep (MachNullAddr)     = AddrRep
 338 literalPrimRep (MachInt _)        = IntRep
 339 literalPrimRep (MachWord _)       = WordRep
 340 literalPrimRep (MachInt64 _)      = Int64Rep
 341 literalPrimRep (MachWord64 _)     = Word64Rep
 342 literalPrimRep (MachFloat _)      = FloatRep
 343 literalPrimRep (MachDouble _)     = DoubleRep
 344 literalPrimRep (MachLabel _ _)    = AddrRep
 345 literalPrimRep (MachLitLit _ ty)  = typePrimRep ty
 346 \end{code}
 347
 348
 349         Comparison
 350         ~~~~~~~~~~
 351 \begin{code}
 352 cmpLit (MachChar      a)   (MachChar       b)   = a `compare` b
 353 cmpLit (MachStr       a)   (MachStr        b)   = a `compare` b
 354 cmpLit (MachNullAddr)      (MachNullAddr)       = EQ
 355 cmpLit (MachInt       a)   (MachInt        b)   = a `compare` b
 356 cmpLit (MachWord      a)   (MachWord       b)   = a `compare` b
 357 cmpLit (MachInt64     a)   (MachInt64      b)   = a `compare` b
 358 cmpLit (MachWord64    a)   (MachWord64     b)   = a `compare` b
 359 cmpLit (MachFloat     a)   (MachFloat      b)   = a `compare` b
 360 cmpLit (MachDouble    a)   (MachDouble     b)   = a `compare` b
 361 cmpLit (MachLabel     a _) (MachLabel      b _) = a `compare` b
 362 cmpLit (MachLitLit    a b) (MachLitLit    c d)  = (a `compare` c) `thenCmp` (b `tcCmpType` d)
 363 cmpLit lit1                lit2                 | litTag lit1 <# litTag lit2 = LT
 364                                                 | otherwise                    = GT
 365
 366 litTag (MachChar      _)   = _ILIT(1)
 367 litTag (MachStr       _)   = _ILIT(2)
 368 litTag (MachNullAddr)      = _ILIT(3)
 369 litTag (MachInt       _)   = _ILIT(4)
 370 litTag (MachWord      _)   = _ILIT(5)
 371 litTag (MachInt64     _)   = _ILIT(6)
 372 litTag (MachWord64    _)   = _ILIT(7)
 373 litTag (MachFloat     _)   = _ILIT(8)
 374 litTag (MachDouble    _)   = _ILIT(9)
 375 litTag (MachLabel   _ _)   = _ILIT(10)
 376 litTag (MachLitLit  _ _)   = _ILIT(11)
 377 \end{code}
 378
 379         Printing
 380         ~~~~~~~~
 381 * MachX (i.e. unboxed) things are printed unadornded (e.g. 3, 'a', "foo")
 382   exceptions: MachFloat gets an initial keyword prefix.
 383
 384 \begin{code}
 385 pprLit lit
 386   = getPprStyle $ \ sty ->
 387     let
 388       code_style  = codeStyle  sty
 389     in
 390     case lit of
 391       MachChar ch | code_style -> hcat [ptext SLIT("(C_)"), text (show ch)]
 392                   | otherwise  -> pprHsChar ch
 393
 394       MachStr s | code_style -> pprFSInCStyle s
 395                 | otherwise  -> pprHsString s
 396       -- Warning: printing MachStr in code_style assumes it contains
 397       -- only characters '\0'..'\xFF'!
 398
 399       MachInt i | code_style && i == tARGET_MIN_INT -> parens (integer (i+1) <> text "-1")
 400                                 -- Avoid a problem whereby gcc interprets
 401                                 -- the constant minInt as unsigned.
 402                 | otherwise -> pprIntVal i
 403
 404       MachInt64 i | code_style -> pprIntVal i           -- Same problem with gcc???
 405                   | otherwise -> ptext SLIT("__int64") <+> integer i
 406
 407       MachWord w | code_style -> pprHexVal w
 408                  | otherwise  -> ptext SLIT("__word") <+> integer w
 409
 410       MachWord64 w | code_style -> pprHexVal w
 411                    | otherwise  -> ptext SLIT("__word64") <+> integer w
 412
 413       MachFloat f | code_style -> ptext SLIT("(StgFloat)") <> code_rational f
 414                   | otherwise  -> ptext SLIT("__float") <+> rational f
 415
 416       MachDouble d | code_style -> code_rational d
 417                    | otherwise  -> rational d
 418
 419       MachNullAddr | code_style -> ptext SLIT("(void*)0")
 420                    | otherwise  -> ptext SLIT("__NULL")
 421
 422       MachLabel l mb
 423          | code_style -> ptext SLIT("(&") <> ftext l <> char ')'
 424          | otherwise  -> ptext SLIT("__label") <+>
 425              case mb of
 426                Nothing -> pprHsString l
 427                Just x  -> doubleQuotes (text (unpackFS l ++ '@':show x))
 428
 429       MachLitLit s ty | code_style  -> ftext s
 430                       | otherwise   -> parens (hsep [ptext SLIT("__litlit"),
 431                                                      pprHsString s,
 432                                                      pprParendType ty])
 433
 434 -- negative floating literals in code style need parentheses to avoid
 435 -- interacting with surrounding syntax.
 436 code_rational d | d < 0     = parens (rational d)
 437                 | otherwise = rational d
 438
 439 pprIntVal :: Integer -> SDoc
 440 -- Print negative integers with parens to be sure it's unambiguous
 441 pprIntVal i | i < 0     = parens (integer i)
 442             | otherwise = integer i
 443
 444 pprHexVal :: Integer -> SDoc
 445 -- Print in C hex format: 0x13fa
 446 pprHexVal 0 = ptext SLIT("0x0")
 447 pprHexVal w = ptext SLIT("0x") <> go w
 448             where
 449               go 0 = empty
 450               go w = go quot <> dig
 451                    where
 452                      (quot,rem) = w `quotRem` 16
 453                      dig | rem < 10  = char (chr (fromInteger rem + ord '0'))
 454                          | otherwise = char (chr (fromInteger rem - 10 + ord 'a'))
 455 \end{code}
 456
 457
 458 %************************************************************************
 459 %*                                                                      *
 460 \subsection{Hashing}
 461 %*                                                                      *
 462 %************************************************************************
 463
 464 Hash values should be zero or a positive integer.  No negatives please.
 465 (They mess up the UniqFM for some reason.)
 466
 467 \begin{code}
 468 hashLiteral :: Literal -> Int
 469 hashLiteral (MachChar c)        = c + 1000      -- Keep it out of range of common ints
 470 hashLiteral (MachStr s)         = hashFS s
 471 hashLiteral (MachNullAddr)      = 0
 472 hashLiteral (MachInt i)         = hashInteger i
 473 hashLiteral (MachInt64 i)       = hashInteger i
 474 hashLiteral (MachWord i)        = hashInteger i
 475 hashLiteral (MachWord64 i)      = hashInteger i
 476 hashLiteral (MachFloat r)       = hashRational r
 477 hashLiteral (MachDouble r)      = hashRational r
 478 hashLiteral (MachLabel s _)     = hashFS s
 479 hashLiteral (MachLitLit s _)    = hashFS s
 480
 481 hashRational :: Rational -> Int
 482 hashRational r = hashInteger (numerator r)
 483
 484 hashInteger :: Integer -> Int
 485 hashInteger i = 1 + abs (fromInteger (i `rem` 10000))
 486                 -- The 1+ is to avoid zero, which is a Bad Number
 487                 -- since we use * to combine hash values
 488
 489 hashFS :: FastString -> Int
 490 hashFS s = iBox (uniqueOfFS s)
 491 \end{code}