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