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